mirror of
https://git.notmuchmail.org/git/notmuch
synced 2024-12-22 09:24:54 +01:00
emacs: Use cl-lib' instead of deprecated cl'
Starting with Emacs 27 the old `cl' implementation is finally considered obsolete. Previously its use was strongly discouraged at run-time but one was still allowed to use it at compile-time. For the most part the transition is very simple and boils down to adding the "cl-" prefix to some symbols. A few replacements do not follow that simple pattern; e.g. `first' is replaced with `car', even though the alias `cl-first' exists, because the latter is not idiomatic emacs-lisp. In a few cases we start using `pcase-let' or `pcase-lambda' instead of renaming e.g. `first' to `car'. That way we can remind the reader of the meaning of the various parts of the data that is being deconstructed. An obsolete `lexical-let' and a `lexical-let*' are replaced with their regular variants `let' and `let*' even though we do not at the same time enable `lexical-binding' for that file. That is the right thing to do because it does not actually make a difference in those cases whether lexical bindings are used or not, and because this should be enabled in a separate commit. We need to explicitly depend on the `cl-lib' package because Emacs 24.1 and 24.2 lack that library. When using these releases we end up using the backport from GNU Elpa. We need to explicitly require the `pcase' library because `pcase-dolist' was not autoloaded until Emacs 25.1.
This commit is contained in:
Jonas Bernoulli
David Bremner
parent
7b756d1e38
commit
11ac932a45
16 changed files with 304 additions and 299 deletions
|
|
@ -27,7 +27,8 @@
|
|||
|
||||
;;; Code:
|
||||
|
||||
(eval-when-compile (require 'cl))
|
||||
(eval-when-compile (require 'cl-lib))
|
||||
|
||||
(require 'notmuch-lib)
|
||||
|
||||
(defvar notmuch-company-last-prefix nil)
|
||||
|
|
@ -65,7 +66,7 @@
|
|||
(require 'company)
|
||||
(let ((case-fold-search t)
|
||||
(completion-ignore-case t))
|
||||
(case command
|
||||
(cl-case command
|
||||
(interactive (company-begin-backend 'notmuch-company))
|
||||
(prefix (and (derived-mode-p 'message-mode)
|
||||
(looking-back (concat notmuch-address-completion-headers-regexp ".*")
|
||||
|
|
|
|||
|
|
@ -152,7 +152,7 @@ Used when a new version is saved, or the message is sent."
|
|||
"Checks if we should save a message that should be encrypted.
|
||||
|
||||
`notmuch-draft-save-plaintext' controls the behaviour."
|
||||
(case notmuch-draft-save-plaintext
|
||||
(cl-case notmuch-draft-save-plaintext
|
||||
((ask)
|
||||
(unless (yes-or-no-p "(Customize `notmuch-draft-save-plaintext' to avoid this warning)
|
||||
This message contains mml tags that suggest it is intended to be encrypted.
|
||||
|
|
|
|||
|
|
@ -21,7 +21,8 @@
|
|||
|
||||
;;; Code:
|
||||
|
||||
(eval-when-compile (require 'cl))
|
||||
(eval-when-compile (require 'cl-lib))
|
||||
|
||||
(require 'widget)
|
||||
(require 'wid-edit) ; For `widget-forward'.
|
||||
|
||||
|
|
@ -47,17 +48,19 @@ lists (NAME QUERY COUNT-QUERY)."
|
|||
((keywordp (car saved-search))
|
||||
(plist-get saved-search field))
|
||||
;; It is not a plist so it is an old-style entry.
|
||||
((consp (cdr saved-search)) ;; It is a list (NAME QUERY COUNT-QUERY)
|
||||
(case field
|
||||
(:name (first saved-search))
|
||||
(:query (second saved-search))
|
||||
(:count-query (third saved-search))
|
||||
(t nil)))
|
||||
(t ;; It is a cons-cell (NAME . QUERY)
|
||||
(case field
|
||||
(:name (car saved-search))
|
||||
(:query (cdr saved-search))
|
||||
(t nil)))))
|
||||
((consp (cdr saved-search))
|
||||
(pcase-let ((`(,name ,query ,count-query) saved-search))
|
||||
(cl-case field
|
||||
(:name name)
|
||||
(:query query)
|
||||
(:count-query count-query)
|
||||
(t nil))))
|
||||
(t
|
||||
(pcase-let ((`(,name . ,query) saved-search))
|
||||
(cl-case field
|
||||
(:name name)
|
||||
(:query query)
|
||||
(t nil))))))
|
||||
|
||||
(defun notmuch-hello-saved-search-to-plist (saved-search)
|
||||
"Return a copy of SAVED-SEARCH in plist form.
|
||||
|
|
@ -66,7 +69,7 @@ If saved search is a plist then just return a copy. In other
|
|||
cases, for backwards compatibility, convert to plist form and
|
||||
return that."
|
||||
(if (keywordp (car saved-search))
|
||||
(copy-seq saved-search)
|
||||
(copy-sequence saved-search)
|
||||
(let ((fields (list :name :query :count-query))
|
||||
plist-search)
|
||||
(dolist (field fields plist-search)
|
||||
|
|
@ -396,10 +399,10 @@ afterwards.")
|
|||
notmuch-saved-searches)))
|
||||
;; If an existing saved search with this name exists, remove it.
|
||||
(setq notmuch-saved-searches
|
||||
(loop for elem in notmuch-saved-searches
|
||||
if (not (equal name
|
||||
(notmuch-saved-search-get elem :name)))
|
||||
collect elem))
|
||||
(cl-loop for elem in notmuch-saved-searches
|
||||
if (not (equal name
|
||||
(notmuch-saved-search-get elem :name)))
|
||||
collect elem))
|
||||
;; Add the new one.
|
||||
(customize-save-variable 'notmuch-saved-searches
|
||||
(add-to-list 'notmuch-saved-searches
|
||||
|
|
@ -417,28 +420,28 @@ afterwards.")
|
|||
(notmuch-hello-update)))
|
||||
|
||||
(defun notmuch-hello-longest-label (searches-alist)
|
||||
(or (loop for elem in searches-alist
|
||||
maximize (length (notmuch-saved-search-get elem :name)))
|
||||
(or (cl-loop for elem in searches-alist
|
||||
maximize (length (notmuch-saved-search-get elem :name)))
|
||||
0))
|
||||
|
||||
(defun notmuch-hello-reflect-generate-row (ncols nrows row list)
|
||||
(let ((len (length list)))
|
||||
(loop for col from 0 to (- ncols 1)
|
||||
collect (let ((offset (+ (* nrows col) row)))
|
||||
(if (< offset len)
|
||||
(nth offset list)
|
||||
;; Don't forget to insert an empty slot in the
|
||||
;; output matrix if there is no corresponding
|
||||
;; value in the input matrix.
|
||||
nil)))))
|
||||
(cl-loop for col from 0 to (- ncols 1)
|
||||
collect (let ((offset (+ (* nrows col) row)))
|
||||
(if (< offset len)
|
||||
(nth offset list)
|
||||
;; Don't forget to insert an empty slot in the
|
||||
;; output matrix if there is no corresponding
|
||||
;; value in the input matrix.
|
||||
nil)))))
|
||||
|
||||
(defun notmuch-hello-reflect (list ncols)
|
||||
"Reflect a `ncols' wide matrix represented by `list' along the
|
||||
diagonal."
|
||||
;; Not very lispy...
|
||||
(let ((nrows (ceiling (length list) ncols)))
|
||||
(loop for row from 0 to (- nrows 1)
|
||||
append (notmuch-hello-reflect-generate-row ncols nrows row list))))
|
||||
(cl-loop for row from 0 to (- nrows 1)
|
||||
append (notmuch-hello-reflect-generate-row ncols nrows row list))))
|
||||
|
||||
(defun notmuch-hello-widget-search (widget &rest ignore)
|
||||
(cond
|
||||
|
|
@ -584,7 +587,7 @@ with `notmuch-hello-query-counts'."
|
|||
(widget-insert (make-string column-indent ? )))
|
||||
(let* ((name (plist-get elem :name))
|
||||
(query (plist-get elem :query))
|
||||
(oldest-first (case (plist-get elem :sort-order)
|
||||
(oldest-first (cl-case (plist-get elem :sort-order)
|
||||
(newest-first nil)
|
||||
(oldest-first t)
|
||||
(otherwise notmuch-search-oldest-first)))
|
||||
|
|
@ -812,48 +815,48 @@ Complete list of currently available key bindings:
|
|||
"clear")
|
||||
(widget-insert "\n\n")
|
||||
(let ((start (point)))
|
||||
(loop for i from 1 to notmuch-hello-recent-searches-max
|
||||
for search in notmuch-search-history do
|
||||
(let ((widget-symbol (intern (format "notmuch-hello-search-%d" i))))
|
||||
(set widget-symbol
|
||||
(widget-create 'editable-field
|
||||
;; Don't let the search boxes be
|
||||
;; less than 8 characters wide.
|
||||
:size (max 8
|
||||
(- (window-width)
|
||||
;; Leave some space
|
||||
;; at the start and
|
||||
;; end of the
|
||||
;; boxes.
|
||||
(* 2 notmuch-hello-indent)
|
||||
;; 1 for the space
|
||||
;; before the
|
||||
;; `[save]' button. 6
|
||||
;; for the `[save]'
|
||||
;; button.
|
||||
1 6
|
||||
;; 1 for the space
|
||||
;; before the `[del]'
|
||||
;; button. 5 for the
|
||||
;; `[del]' button.
|
||||
1 5))
|
||||
:action (lambda (widget &rest ignore)
|
||||
(notmuch-hello-search (widget-value widget)))
|
||||
search))
|
||||
(widget-insert " ")
|
||||
(widget-create 'push-button
|
||||
:notify (lambda (widget &rest ignore)
|
||||
(notmuch-hello-add-saved-search widget))
|
||||
:notmuch-saved-search-widget widget-symbol
|
||||
"save")
|
||||
(widget-insert " ")
|
||||
(widget-create 'push-button
|
||||
:notify (lambda (widget &rest ignore)
|
||||
(when (y-or-n-p "Are you sure you want to delete this search? ")
|
||||
(notmuch-hello-delete-search-from-history widget)))
|
||||
:notmuch-saved-search-widget widget-symbol
|
||||
"del"))
|
||||
(widget-insert "\n"))
|
||||
(cl-loop for i from 1 to notmuch-hello-recent-searches-max
|
||||
for search in notmuch-search-history do
|
||||
(let ((widget-symbol (intern (format "notmuch-hello-search-%d" i))))
|
||||
(set widget-symbol
|
||||
(widget-create 'editable-field
|
||||
;; Don't let the search boxes be
|
||||
;; less than 8 characters wide.
|
||||
:size (max 8
|
||||
(- (window-width)
|
||||
;; Leave some space
|
||||
;; at the start and
|
||||
;; end of the
|
||||
;; boxes.
|
||||
(* 2 notmuch-hello-indent)
|
||||
;; 1 for the space
|
||||
;; before the
|
||||
;; `[save]' button. 6
|
||||
;; for the `[save]'
|
||||
;; button.
|
||||
1 6
|
||||
;; 1 for the space
|
||||
;; before the `[del]'
|
||||
;; button. 5 for the
|
||||
;; `[del]' button.
|
||||
1 5))
|
||||
:action (lambda (widget &rest ignore)
|
||||
(notmuch-hello-search (widget-value widget)))
|
||||
search))
|
||||
(widget-insert " ")
|
||||
(widget-create 'push-button
|
||||
:notify (lambda (widget &rest ignore)
|
||||
(notmuch-hello-add-saved-search widget))
|
||||
:notmuch-saved-search-widget widget-symbol
|
||||
"save")
|
||||
(widget-insert " ")
|
||||
(widget-create 'push-button
|
||||
:notify (lambda (widget &rest ignore)
|
||||
(when (y-or-n-p "Are you sure you want to delete this search? ")
|
||||
(notmuch-hello-delete-search-from-history widget)))
|
||||
:notmuch-saved-search-widget widget-symbol
|
||||
"del"))
|
||||
(widget-insert "\n"))
|
||||
(indent-rigidly start (point) notmuch-hello-indent))
|
||||
nil))
|
||||
|
||||
|
|
|
|||
|
|
@ -22,7 +22,9 @@
|
|||
|
||||
;;; Code:
|
||||
|
||||
(eval-when-compile (require 'cl))
|
||||
(eval-when-compile
|
||||
(require 'cl-lib)
|
||||
(require 'pcase))
|
||||
|
||||
(require 'notmuch-lib)
|
||||
(require 'notmuch-hello)
|
||||
|
|
@ -51,7 +53,7 @@ fast way to jump to a saved search from anywhere in Notmuch."
|
|||
(let ((name (plist-get saved-search :name))
|
||||
(query (plist-get saved-search :query))
|
||||
(oldest-first
|
||||
(case (plist-get saved-search :sort-order)
|
||||
(cl-case (plist-get saved-search :sort-order)
|
||||
(newest-first nil)
|
||||
(oldest-first t)
|
||||
(otherwise (default-value 'notmuch-search-oldest-first)))))
|
||||
|
|
@ -127,18 +129,16 @@ buffer."
|
|||
|
||||
;; Compute the maximum key description width
|
||||
(let ((key-width 1))
|
||||
(dolist (entry action-map)
|
||||
(pcase-dolist (`(,key ,desc) action-map)
|
||||
(setq key-width
|
||||
(max key-width
|
||||
(string-width (format-kbd-macro (first entry))))))
|
||||
(string-width (format-kbd-macro key)))))
|
||||
;; Format each action
|
||||
(mapcar (lambda (entry)
|
||||
(let ((key (format-kbd-macro (first entry)))
|
||||
(desc (second entry)))
|
||||
(concat
|
||||
(propertize key 'face 'minibuffer-prompt)
|
||||
(make-string (- key-width (length key)) ? )
|
||||
" " desc)))
|
||||
(mapcar (pcase-lambda (`(,key ,desc))
|
||||
(setq key (format-kbd-macro key))
|
||||
(concat (propertize key 'face 'minibuffer-prompt)
|
||||
(make-string (- key-width (length key)) ? )
|
||||
" " desc))
|
||||
action-map)))
|
||||
|
||||
(defun notmuch-jump--insert-items (width items)
|
||||
|
|
@ -173,28 +173,25 @@ buffer."
|
|||
"Translate ACTION-MAP into a minibuffer keymap."
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(set-keymap-parent map notmuch-jump-minibuffer-map)
|
||||
(dolist (action action-map)
|
||||
(if (= (length (first action)) 1)
|
||||
(define-key map (first action)
|
||||
(pcase-dolist (`(,key ,name ,fn) action-map)
|
||||
(if (= (length key) 1)
|
||||
(define-key map key
|
||||
`(lambda () (interactive)
|
||||
(setq notmuch-jump--action ',(third action))
|
||||
(setq notmuch-jump--action ',fn)
|
||||
(exit-minibuffer)))))
|
||||
;; By doing this in two passes (and checking if we already have a
|
||||
;; binding) we avoid problems if the user specifies a binding which
|
||||
;; is a prefix of another binding.
|
||||
(dolist (action action-map)
|
||||
(if (> (length (first action)) 1)
|
||||
(let* ((key (elt (first action) 0))
|
||||
(pcase-dolist (`(,key ,name ,fn) action-map)
|
||||
(if (> (length key) 1)
|
||||
(let* ((key (elt key 0))
|
||||
(keystr (string key))
|
||||
(new-prompt (concat prompt (format-kbd-macro keystr) " "))
|
||||
(action-submap nil))
|
||||
(unless (lookup-key map keystr)
|
||||
(dolist (act action-map)
|
||||
(when (= key (elt (first act) 0))
|
||||
(push (list (substring (first act) 1)
|
||||
(second act)
|
||||
(third act))
|
||||
action-submap)))
|
||||
(pcase-dolist (`(,k ,n ,f) action-map)
|
||||
(when (= key (elt k 0))
|
||||
(push (list (substring k 1) n f) action-submap)))
|
||||
;; We deal with backspace specially
|
||||
(push (list (kbd "DEL")
|
||||
"Backup"
|
||||
|
|
|
|||
|
|
@ -23,10 +23,12 @@
|
|||
|
||||
;;; Code:
|
||||
|
||||
(require 'cl-lib)
|
||||
|
||||
(require 'mm-util)
|
||||
(require 'mm-view)
|
||||
(require 'mm-decode)
|
||||
(require 'cl)
|
||||
|
||||
(require 'notmuch-compat)
|
||||
|
||||
(unless (require 'notmuch-version nil t)
|
||||
|
|
@ -574,7 +576,7 @@ for this message, if present."
|
|||
(defun notmuch-parts-filter-by-type (parts type)
|
||||
"Given a list of message parts, return a list containing the ones matching
|
||||
the given type."
|
||||
(remove-if-not
|
||||
(cl-remove-if-not
|
||||
(lambda (part) (notmuch-match-content-type (plist-get part :content-type) type))
|
||||
parts))
|
||||
|
||||
|
|
@ -685,8 +687,8 @@ current buffer, if possible."
|
|||
;; have symbols of the form :Header as keys, and the resulting alist will have
|
||||
;; symbols of the form 'Header as keys.
|
||||
(defun notmuch-headers-plist-to-alist (plist)
|
||||
(loop for (key value . rest) on plist by #'cddr
|
||||
collect (cons (intern (substring (symbol-name key) 1)) value)))
|
||||
(cl-loop for (key value . rest) on plist by #'cddr
|
||||
collect (cons (intern (substring (symbol-name key) 1)) value)))
|
||||
|
||||
(defun notmuch-face-ensure-list-form (face)
|
||||
"Return FACE in face list form.
|
||||
|
|
@ -780,7 +782,7 @@ arguments passed to the sentinel. COMMAND and ERR, if provided,
|
|||
are passed to `notmuch-check-exit-status'. If COMMAND is not
|
||||
provided, it is taken from `process-command'."
|
||||
(let ((exit-status
|
||||
(case (process-status proc)
|
||||
(cl-case (process-status proc)
|
||||
((exit) (process-exit-status proc))
|
||||
((signal) msg))))
|
||||
(when exit-status
|
||||
|
|
@ -848,7 +850,7 @@ for `call-process'. ARGS is as described for
|
|||
|
||||
(let (stdin-string)
|
||||
(while (keywordp (car args))
|
||||
(case (car args)
|
||||
(cl-case (car args)
|
||||
(:stdin-string (setq stdin-string (cadr args)
|
||||
args (cddr args)))
|
||||
(otherwise
|
||||
|
|
@ -1026,8 +1028,4 @@ region if the region is active, or both `point' otherwise."
|
|||
|
||||
(provide 'notmuch-lib)
|
||||
|
||||
;; Local Variables:
|
||||
;; byte-compile-warnings: (not cl-functions)
|
||||
;; End:
|
||||
|
||||
;;; notmuch-lib.el ends here
|
||||
|
|
|
|||
|
|
@ -22,7 +22,8 @@
|
|||
|
||||
;;; Code:
|
||||
|
||||
(eval-when-compile (require 'cl))
|
||||
(eval-when-compile (require 'cl-lib))
|
||||
|
||||
(require 'message)
|
||||
|
||||
(require 'notmuch-lib)
|
||||
|
|
@ -251,12 +252,12 @@ If CREATE is non-nil then create the folder if necessary."
|
|||
(let ((response (notmuch-read-char-choice
|
||||
"Insert failed: (r)etry, (c)reate folder, (i)gnore, or (e)dit the header? "
|
||||
'(?r ?c ?i ?e))))
|
||||
(case response
|
||||
(?r (notmuch-maildir-fcc-with-notmuch-insert fcc-header))
|
||||
(?c (notmuch-maildir-fcc-with-notmuch-insert fcc-header 't))
|
||||
(?i 't)
|
||||
(?e (notmuch-maildir-fcc-with-notmuch-insert
|
||||
(read-from-minibuffer "Fcc header: " fcc-header)))))))))
|
||||
(cl-case response
|
||||
(?r (notmuch-maildir-fcc-with-notmuch-insert fcc-header))
|
||||
(?c (notmuch-maildir-fcc-with-notmuch-insert fcc-header 't))
|
||||
(?i 't)
|
||||
(?e (notmuch-maildir-fcc-with-notmuch-insert
|
||||
(read-from-minibuffer "Fcc header: " fcc-header)))))))))
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
|
@ -335,16 +336,16 @@ if needed."
|
|||
(let* ((prompt (format "Fcc %s is not a maildir: (r)etry, (c)reate folder, (i)gnore, or (e)dit the header? "
|
||||
fcc-header))
|
||||
(response (notmuch-read-char-choice prompt '(?r ?c ?i ?e))))
|
||||
(case response
|
||||
(?r (notmuch-maildir-fcc-file-fcc fcc-header))
|
||||
(?c (if (file-writable-p fcc-header)
|
||||
(notmuch-maildir-fcc-create-maildir fcc-header)
|
||||
(message "No permission to create %s." fcc-header)
|
||||
(sit-for 2))
|
||||
(notmuch-maildir-fcc-file-fcc fcc-header))
|
||||
(?i 't)
|
||||
(?e (notmuch-maildir-fcc-file-fcc
|
||||
(read-from-minibuffer "Fcc header: " fcc-header)))))))
|
||||
(cl-case response
|
||||
(?r (notmuch-maildir-fcc-file-fcc fcc-header))
|
||||
(?c (if (file-writable-p fcc-header)
|
||||
(notmuch-maildir-fcc-create-maildir fcc-header)
|
||||
(message "No permission to create %s." fcc-header)
|
||||
(sit-for 2))
|
||||
(notmuch-maildir-fcc-file-fcc fcc-header))
|
||||
(?i 't)
|
||||
(?e (notmuch-maildir-fcc-file-fcc
|
||||
(read-from-minibuffer "Fcc header: " fcc-header)))))))
|
||||
|
||||
(defun notmuch-maildir-fcc-write-buffer-to-maildir (destdir &optional mark-seen)
|
||||
"Writes the current buffer to maildir destdir. If mark-seen is
|
||||
|
|
|
|||
|
|
@ -21,6 +21,8 @@
|
|||
|
||||
;;; Code:
|
||||
|
||||
(eval-when-compile (require 'cl-lib))
|
||||
|
||||
(require 'message)
|
||||
(require 'mm-view)
|
||||
(require 'format-spec)
|
||||
|
|
@ -30,8 +32,6 @@
|
|||
(require 'notmuch-draft)
|
||||
(require 'notmuch-message)
|
||||
|
||||
(eval-when-compile (require 'cl))
|
||||
|
||||
(declare-function notmuch-show-insert-body "notmuch-show" (msg body depth))
|
||||
(declare-function notmuch-fcc-header-setup "notmuch-maildir-fcc" ())
|
||||
(declare-function notmuch-maildir-message-do-fcc "notmuch-maildir-fcc" ())
|
||||
|
|
@ -140,17 +140,18 @@ Typically this is added to `notmuch-mua-send-hook'."
|
|||
;; Limit search from reaching other possible parts of the message
|
||||
(let ((search-limit (search-forward "\n<#" nil t)))
|
||||
(message-goto-body)
|
||||
(loop while (re-search-forward notmuch-mua-attachment-regexp search-limit t)
|
||||
;; For every instance of the "attachment" string
|
||||
;; found, examine the text properties. If the text
|
||||
;; has either a `face' or `syntax-table' property
|
||||
;; then it is quoted text and should *not* cause the
|
||||
;; user to be asked about a missing attachment.
|
||||
if (let ((props (text-properties-at (match-beginning 0))))
|
||||
(not (or (memq 'syntax-table props)
|
||||
(memq 'face props))))
|
||||
return t
|
||||
finally return nil)))
|
||||
(cl-loop while (re-search-forward notmuch-mua-attachment-regexp
|
||||
search-limit t)
|
||||
;; For every instance of the "attachment" string
|
||||
;; found, examine the text properties. If the text
|
||||
;; has either a `face' or `syntax-table' property
|
||||
;; then it is quoted text and should *not* cause the
|
||||
;; user to be asked about a missing attachment.
|
||||
if (let ((props (text-properties-at (match-beginning 0))))
|
||||
(not (or (memq 'syntax-table props)
|
||||
(memq 'face props))))
|
||||
return t
|
||||
finally return nil)))
|
||||
;; ...but doesn't have a part with a filename...
|
||||
(save-excursion
|
||||
(message-goto-body)
|
||||
|
|
@ -203,11 +204,11 @@ Typically this is added to `notmuch-mua-send-hook'."
|
|||
|
||||
(defun notmuch-mua-reply-crypto (parts)
|
||||
"Add mml sign-encrypt flag if any part of original message is encrypted."
|
||||
(loop for part in parts
|
||||
if (notmuch-match-content-type (plist-get part :content-type) "multipart/encrypted")
|
||||
do (mml-secure-message-sign-encrypt)
|
||||
else if (notmuch-match-content-type (plist-get part :content-type) "multipart/*")
|
||||
do (notmuch-mua-reply-crypto (plist-get part :content))))
|
||||
(cl-loop for part in parts
|
||||
if (notmuch-match-content-type (plist-get part :content-type) "multipart/encrypted")
|
||||
do (mml-secure-message-sign-encrypt)
|
||||
else if (notmuch-match-content-type (plist-get part :content-type) "multipart/*")
|
||||
do (notmuch-mua-reply-crypto (plist-get part :content))))
|
||||
|
||||
;; There is a bug in emacs 23's message.el that results in a newline
|
||||
;; not being inserted after the References header, so the next header
|
||||
|
|
@ -252,14 +253,14 @@ Typically this is added to `notmuch-mua-send-hook'."
|
|||
;; We modify message-header-format-alist to get around a bug in message.el.
|
||||
;; See the comment above on notmuch-mua-insert-references.
|
||||
(let ((message-header-format-alist
|
||||
(loop for pair in message-header-format-alist
|
||||
if (eq (car pair) 'References)
|
||||
collect (cons 'References
|
||||
(apply-partially
|
||||
'notmuch-mua-insert-references
|
||||
(cdr pair)))
|
||||
else
|
||||
collect pair)))
|
||||
(cl-loop for pair in message-header-format-alist
|
||||
if (eq (car pair) 'References)
|
||||
collect (cons 'References
|
||||
(apply-partially
|
||||
'notmuch-mua-insert-references
|
||||
(cdr pair)))
|
||||
else
|
||||
collect pair)))
|
||||
(notmuch-mua-mail (plist-get reply-headers :To)
|
||||
(notmuch-sanitize (plist-get reply-headers :Subject))
|
||||
(notmuch-headers-plist-to-alist reply-headers)
|
||||
|
|
@ -309,10 +310,10 @@ Typically this is added to `notmuch-mua-send-hook'."
|
|||
;; Don't indent multipart sub-parts.
|
||||
(notmuch-show-indent-multipart nil))
|
||||
;; We don't want sigstatus buttons (an information leak and usually wrong anyway).
|
||||
(letf (((symbol-function 'notmuch-crypto-insert-sigstatus-button) #'ignore)
|
||||
((symbol-function 'notmuch-crypto-insert-encstatus-button) #'ignore))
|
||||
(notmuch-show-insert-body original (plist-get original :body) 0)
|
||||
(buffer-substring-no-properties (point-min) (point-max))))))
|
||||
(cl-letf (((symbol-function 'notmuch-crypto-insert-sigstatus-button) #'ignore)
|
||||
((symbol-function 'notmuch-crypto-insert-encstatus-button) #'ignore))
|
||||
(notmuch-show-insert-body original (plist-get original :body) 0)
|
||||
(buffer-substring-no-properties (point-min) (point-max))))))
|
||||
|
||||
(set-mark (point))
|
||||
(goto-char start)
|
||||
|
|
@ -526,10 +527,9 @@ the From: address."
|
|||
;; Create a buffer-local queue for tag changes triggered when sending the message
|
||||
(when notmuch-message-forwarded-tags
|
||||
(setq-local notmuch-message-queued-tag-changes
|
||||
(loop for id in forward-queries
|
||||
collect
|
||||
(cons id
|
||||
notmuch-message-forwarded-tags))))
|
||||
(cl-loop for id in forward-queries
|
||||
collect
|
||||
(cons id notmuch-message-forwarded-tags))))
|
||||
|
||||
;; `message-forward-make-body' shows the User-agent header. Hide
|
||||
;; it again.
|
||||
|
|
@ -609,10 +609,10 @@ unencrypted. Really send? "))))
|
|||
(run-hooks 'notmuch-mua-send-hook)
|
||||
(when (and (notmuch-mua-check-no-misplaced-secure-tag)
|
||||
(notmuch-mua-check-secure-tag-has-newline))
|
||||
(letf (((symbol-function 'message-do-fcc) #'notmuch-maildir-message-do-fcc))
|
||||
(if exit
|
||||
(message-send-and-exit arg)
|
||||
(message-send arg)))))
|
||||
(cl-letf (((symbol-function 'message-do-fcc) #'notmuch-maildir-message-do-fcc))
|
||||
(if exit
|
||||
(message-send-and-exit arg)
|
||||
(message-send arg)))))
|
||||
|
||||
(defun notmuch-mua-send-and-exit (&optional arg)
|
||||
(interactive "P")
|
||||
|
|
|
|||
|
|
@ -21,7 +21,7 @@
|
|||
|
||||
;;; Code:
|
||||
|
||||
(require 'cl)
|
||||
(eval-when-compile (require 'cl-lib))
|
||||
|
||||
(defun notmuch-sexp-create-parser ()
|
||||
"Return a new streaming S-expression parser.
|
||||
|
|
@ -70,7 +70,7 @@ returns the value."
|
|||
;; error to be consistent with all other code paths.
|
||||
(read (current-buffer))
|
||||
;; Go up a level and return an end token
|
||||
(decf (notmuch-sexp--depth sp))
|
||||
(cl-decf (notmuch-sexp--depth sp))
|
||||
(forward-char)
|
||||
'end))
|
||||
((= (char-after) ?\()
|
||||
|
|
@ -94,8 +94,8 @@ returns the value."
|
|||
(notmuch-sexp--partial-state sp)))
|
||||
;; A complete value is available if we've
|
||||
;; reached depth 0.
|
||||
(depth (first new-state)))
|
||||
(assert (>= depth 0))
|
||||
(depth (car new-state)))
|
||||
(cl-assert (>= depth 0))
|
||||
(if (= depth 0)
|
||||
;; Reset partial parse state
|
||||
(setf (notmuch-sexp--partial-state sp) nil
|
||||
|
|
@ -139,7 +139,7 @@ beginning of a list, throw invalid-read-syntax."
|
|||
(cond ((eobp) 'retry)
|
||||
((= (char-after) ?\()
|
||||
(forward-char)
|
||||
(incf (notmuch-sexp--depth sp))
|
||||
(cl-incf (notmuch-sexp--depth sp))
|
||||
t)
|
||||
(t
|
||||
;; Skip over the bad character like `read' does
|
||||
|
|
@ -181,7 +181,7 @@ move point in the input buffer."
|
|||
(set (make-local-variable 'notmuch-sexp--state) 'begin))
|
||||
(let (done)
|
||||
(while (not done)
|
||||
(case notmuch-sexp--state
|
||||
(cl-case notmuch-sexp--state
|
||||
(begin
|
||||
;; Enter the list
|
||||
(if (eq (notmuch-sexp-begin-list notmuch-sexp--parser) 'retry)
|
||||
|
|
@ -190,7 +190,7 @@ move point in the input buffer."
|
|||
(result
|
||||
;; Parse a result
|
||||
(let ((result (notmuch-sexp-read notmuch-sexp--parser)))
|
||||
(case result
|
||||
(cl-case result
|
||||
(retry (setq done t))
|
||||
(end (setq notmuch-sexp--state 'end))
|
||||
(t (with-current-buffer result-buffer
|
||||
|
|
@ -204,8 +204,4 @@ move point in the input buffer."
|
|||
|
||||
(provide 'notmuch-parser)
|
||||
|
||||
;; Local Variables:
|
||||
;; byte-compile-warnings: (not cl-functions)
|
||||
;; End:
|
||||
|
||||
;;; notmuch-parser.el ends here
|
||||
|
|
|
|||
|
|
@ -3,4 +3,5 @@
|
|||
"notmuch"
|
||||
%VERSION%
|
||||
"Emacs based front-end (MUA) for notmuch"
|
||||
'((emacs "24")))
|
||||
'((emacs "24")
|
||||
(cl-lib "0.6.1")))
|
||||
|
|
|
|||
|
|
@ -23,7 +23,10 @@
|
|||
|
||||
;;; Code:
|
||||
|
||||
(eval-when-compile (require 'cl))
|
||||
(eval-when-compile
|
||||
(require 'cl-lib)
|
||||
(require 'pcase))
|
||||
|
||||
(require 'mm-view)
|
||||
(require 'message)
|
||||
(require 'mm-decode)
|
||||
|
|
@ -429,17 +432,16 @@ parsing fails."
|
|||
(setq p-name (replace-regexp-in-string "\\\\" "" p-name))
|
||||
|
||||
;; Outer single and double quotes, which might be nested.
|
||||
(loop
|
||||
with start-of-loop
|
||||
do (setq start-of-loop p-name)
|
||||
(cl-loop with start-of-loop
|
||||
do (setq start-of-loop p-name)
|
||||
|
||||
when (string-match "^\"\\(.*\\)\"$" p-name)
|
||||
do (setq p-name (match-string 1 p-name))
|
||||
when (string-match "^\"\\(.*\\)\"$" p-name)
|
||||
do (setq p-name (match-string 1 p-name))
|
||||
|
||||
when (string-match "^'\\(.*\\)'$" p-name)
|
||||
do (setq p-name (match-string 1 p-name))
|
||||
when (string-match "^'\\(.*\\)'$" p-name)
|
||||
do (setq p-name (match-string 1 p-name))
|
||||
|
||||
until (string= start-of-loop p-name)))
|
||||
until (string= start-of-loop p-name)))
|
||||
|
||||
;; If the address is 'foo@bar.com <foo@bar.com>' then show just
|
||||
;; 'foo@bar.com'.
|
||||
|
|
@ -573,13 +575,13 @@ message at DEPTH in the current thread."
|
|||
;; Recurse on sub-parts
|
||||
(let ((ctype (notmuch-split-content-type
|
||||
(downcase (plist-get part :content-type)))))
|
||||
(cond ((equal (first ctype) "multipart")
|
||||
(cond ((equal (car ctype) "multipart")
|
||||
(mapc (apply-partially #'notmuch-show--register-cids msg)
|
||||
(plist-get part :content)))
|
||||
((equal ctype '("message" "rfc822"))
|
||||
(notmuch-show--register-cids
|
||||
msg
|
||||
(first (plist-get (first (plist-get part :content)) :body)))))))
|
||||
(car (plist-get (car (plist-get part :content)) :body)))))))
|
||||
|
||||
(defun notmuch-show--get-cid-content (cid)
|
||||
"Return a list (CID-content content-type) or nil.
|
||||
|
|
@ -590,8 +592,8 @@ enclosing angle brackets, a cid: prefix, or URL encoding. This
|
|||
will return nil if the CID is unknown or cannot be retrieved."
|
||||
(let ((descriptor (cdr (assoc cid notmuch-show--cids))))
|
||||
(when descriptor
|
||||
(let* ((msg (first descriptor))
|
||||
(part (second descriptor))
|
||||
(let* ((msg (car descriptor))
|
||||
(part (cadr descriptor))
|
||||
;; Request caching for this content, as some messages
|
||||
;; reference the same cid: part many times (hundreds!).
|
||||
(content (notmuch-get-bodypart-binary
|
||||
|
|
@ -616,8 +618,8 @@ will return nil if the CID is unknown or cannot be retrieved."
|
|||
(with-current-buffer w3m-current-buffer
|
||||
(notmuch-show--get-cid-content cid))))
|
||||
(when content-and-type
|
||||
(insert (first content-and-type))
|
||||
(second content-and-type))))
|
||||
(insert (car content-and-type))
|
||||
(cadr content-and-type))))
|
||||
|
||||
;; MIME part renderers
|
||||
|
||||
|
|
@ -785,7 +787,7 @@ will return nil if the CID is unknown or cannot be retrieved."
|
|||
;; is defined before it will be shadowed by the letf below. Otherwise the version
|
||||
;; in enriched.el may be loaded a bit later and used instead (for the first time).
|
||||
(require 'enriched)
|
||||
(letf (((symbol-function 'enriched-decode-display-prop)
|
||||
(cl-letf (((symbol-function 'enriched-decode-display-prop)
|
||||
(lambda (start end &optional param) (list start end))))
|
||||
(notmuch-show-insert-part-*/* msg part content-type nth depth button))))
|
||||
|
||||
|
|
@ -843,7 +845,7 @@ will return nil if the CID is unknown or cannot be retrieved."
|
|||
;; shr strips the "cid:" part of URL, but doesn't
|
||||
;; URL-decode it (see RFC 2392).
|
||||
(let ((cid (url-unhex-string url)))
|
||||
(first (notmuch-show--get-cid-content cid))))))
|
||||
(car (notmuch-show--get-cid-content cid))))))
|
||||
(shr-insert-document dom)
|
||||
t))
|
||||
|
||||
|
|
@ -873,15 +875,16 @@ will return nil if the CID is unknown or cannot be retrieved."
|
|||
|
||||
(defun notmuch-show-insert-bodypart-internal (msg part content-type nth depth button)
|
||||
;; Run the handlers until one of them succeeds.
|
||||
(loop for handler in (notmuch-show-handlers-for content-type)
|
||||
until (condition-case err
|
||||
(funcall handler msg part content-type nth depth button)
|
||||
;; Specifying `debug' here lets the debugger run if
|
||||
;; `debug-on-error' is non-nil.
|
||||
((debug error)
|
||||
(insert "!!! Bodypart handler `" (prin1-to-string handler) "' threw an error:\n"
|
||||
"!!! " (error-message-string err) "\n")
|
||||
nil))))
|
||||
(cl-loop for handler in (notmuch-show-handlers-for content-type)
|
||||
until (condition-case err
|
||||
(funcall handler msg part content-type nth depth button)
|
||||
;; Specifying `debug' here lets the debugger run if
|
||||
;; `debug-on-error' is non-nil.
|
||||
((debug error)
|
||||
(insert "!!! Bodypart handler `" (prin1-to-string handler)
|
||||
"' threw an error:\n"
|
||||
"!!! " (error-message-string err) "\n")
|
||||
nil))))
|
||||
|
||||
(defun notmuch-show-create-part-overlays (button beg end)
|
||||
"Add an overlay to the part between BEG and END"
|
||||
|
|
@ -907,13 +910,15 @@ will return nil if the CID is unknown or cannot be retrieved."
|
|||
;; watch out for sticky specs of t, which means all properties are
|
||||
;; front-sticky/rear-nonsticky.
|
||||
(notmuch-map-text-property beg end 'front-sticky
|
||||
(lambda (v) (if (listp v)
|
||||
(pushnew :notmuch-part v)
|
||||
v)))
|
||||
(lambda (v)
|
||||
(if (listp v)
|
||||
(cl-pushnew :notmuch-part v)
|
||||
v)))
|
||||
(notmuch-map-text-property beg end 'rear-nonsticky
|
||||
(lambda (v) (if (listp v)
|
||||
(pushnew :notmuch-part v)
|
||||
v))))
|
||||
(lambda (v)
|
||||
(if (listp v)
|
||||
(cl-pushnew :notmuch-part v)
|
||||
v))))
|
||||
|
||||
(defun notmuch-show-lazy-part (part-args button)
|
||||
;; Insert the lazy part after the button for the part. We would just
|
||||
|
|
@ -941,7 +946,7 @@ will return nil if the CID is unknown or cannot be retrieved."
|
|||
(indent-rigidly part-beg part-end (* notmuch-show-indent-messages-width depth)))
|
||||
(goto-char part-end)
|
||||
(delete-char 1)
|
||||
(notmuch-show-record-part-information (second part-args)
|
||||
(notmuch-show-record-part-information (cadr part-args)
|
||||
(button-start button)
|
||||
part-end)
|
||||
;; Create the overlay. If the lazy-part turned out to be empty/not
|
||||
|
|
@ -1037,7 +1042,7 @@ is t, hide the part initially and show the button."
|
|||
;; Register all content IDs for this message. According to RFC
|
||||
;; 2392, content IDs are *global*, but it's okay if an MUA treats
|
||||
;; them as only global within a message.
|
||||
(notmuch-show--register-cids msg (first body))
|
||||
(notmuch-show--register-cids msg (car body))
|
||||
|
||||
(mapc (lambda (part) (notmuch-show-insert-bodypart msg part depth)) body))
|
||||
|
||||
|
|
@ -1220,13 +1225,13 @@ buttons for a corresponding notmuch search."
|
|||
(url-unhex-string (match-string 0 mid-cid)))))
|
||||
(push (list (match-beginning 0) (match-end 0)
|
||||
(notmuch-id-to-query mid)) links)))
|
||||
(dolist (link links)
|
||||
(pcase-dolist (`(,beg ,end ,link) links)
|
||||
;; Remove the overlay created by goto-address-mode
|
||||
(remove-overlays (first link) (second link) 'goto-address t)
|
||||
(make-text-button (first link) (second link)
|
||||
(remove-overlays beg end 'goto-address t)
|
||||
(make-text-button beg end
|
||||
:type 'notmuch-button-type
|
||||
'action `(lambda (arg)
|
||||
(notmuch-show ,(third link) current-prefix-arg))
|
||||
(notmuch-show ,link current-prefix-arg))
|
||||
'follow-link t
|
||||
'help-echo "Mouse-1, RET: search for this message"
|
||||
'face goto-address-mail-face)))))
|
||||
|
|
@ -1387,9 +1392,9 @@ This includes:
|
|||
(defun notmuch-show-goto-message (msg-id)
|
||||
"Go to message with msg-id."
|
||||
(goto-char (point-min))
|
||||
(unless (loop if (string= msg-id (notmuch-show-get-message-id))
|
||||
return t
|
||||
until (not (notmuch-show-goto-message-next)))
|
||||
(unless (cl-loop if (string= msg-id (notmuch-show-get-message-id))
|
||||
return t
|
||||
until (not (notmuch-show-goto-message-next)))
|
||||
(goto-char (point-min))
|
||||
(message "Message-id not found."))
|
||||
(notmuch-show-message-adjust))
|
||||
|
|
@ -1406,9 +1411,9 @@ This includes:
|
|||
|
||||
;; Open those that were open.
|
||||
(goto-char (point-min))
|
||||
(loop do (notmuch-show-message-visible (notmuch-show-get-message-properties)
|
||||
(member (notmuch-show-get-message-id) open))
|
||||
until (not (notmuch-show-goto-message-next)))
|
||||
(cl-loop do (notmuch-show-message-visible (notmuch-show-get-message-properties)
|
||||
(member (notmuch-show-get-message-id) open))
|
||||
until (not (notmuch-show-goto-message-next)))
|
||||
|
||||
(dolist (win-msg-pair win-msg-alist)
|
||||
(with-selected-window (car win-msg-pair)
|
||||
|
|
@ -1620,8 +1625,8 @@ of the current message."
|
|||
effects."
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(loop do (funcall function)
|
||||
while (notmuch-show-goto-message-next))))
|
||||
(cl-loop do (funcall function)
|
||||
while (notmuch-show-goto-message-next))))
|
||||
|
||||
;; Functions relating to the visibility of messages and their
|
||||
;; components.
|
||||
|
|
@ -2177,9 +2182,9 @@ argument, hide all of the messages."
|
|||
(interactive)
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(loop do (notmuch-show-message-visible (notmuch-show-get-message-properties)
|
||||
(not current-prefix-arg))
|
||||
until (not (notmuch-show-goto-message-next))))
|
||||
(cl-loop do (notmuch-show-message-visible (notmuch-show-get-message-properties)
|
||||
(not current-prefix-arg))
|
||||
until (not (notmuch-show-goto-message-next))))
|
||||
(force-window-update))
|
||||
|
||||
(defun notmuch-show-next-button ()
|
||||
|
|
|
|||
|
|
@ -24,8 +24,12 @@
|
|||
;;; Code:
|
||||
;;
|
||||
|
||||
(require 'cl)
|
||||
(require 'cl-lib)
|
||||
(eval-when-compile
|
||||
(require 'pcase))
|
||||
|
||||
(require 'crm)
|
||||
|
||||
(require 'notmuch-lib)
|
||||
|
||||
(declare-function notmuch-search-tag "notmuch" tag-changes)
|
||||
|
|
@ -277,10 +281,10 @@ This can be used with `notmuch-tag-format-image-data'."
|
|||
(save-match-data
|
||||
;; Don't use assoc-default since there's no way to distinguish a
|
||||
;; missing key from a present key with a null cdr.
|
||||
(assoc* tag format-alist
|
||||
:test (lambda (tag key)
|
||||
(and (eq (string-match key tag) 0)
|
||||
(= (match-end 0) (length tag)))))))
|
||||
(cl-assoc tag format-alist
|
||||
:test (lambda (tag key)
|
||||
(and (eq (string-match key tag) 0)
|
||||
(= (match-end 0) (length tag)))))))
|
||||
|
||||
(defun notmuch-tag--do-format (tag formatted-tag formats)
|
||||
"Apply a tag-formats entry to TAG."
|
||||
|
|
@ -315,7 +319,7 @@ changed (the normal case) are shown using formats from
|
|||
(formatted-tag (gethash (cons tag tag-state) notmuch-tag--format-cache 'missing)))
|
||||
(when (eq formatted-tag 'missing)
|
||||
(let ((base (notmuch-tag--get-formats tag notmuch-tag-formats))
|
||||
(over (case tag-state
|
||||
(over (cl-case tag-state
|
||||
(deleted (notmuch-tag--get-formats
|
||||
tag notmuch-tag-deleted-formats))
|
||||
(added (notmuch-tag--get-formats
|
||||
|
|
@ -436,7 +440,7 @@ from TAGS if present."
|
|||
(dolist (tag-change tag-changes)
|
||||
(let ((op (string-to-char tag-change))
|
||||
(tag (unless (string= tag-change "") (substring tag-change 1))))
|
||||
(case op
|
||||
(cl-case op
|
||||
(?+ (unless (member tag result-tags)
|
||||
(push tag result-tags)))
|
||||
(?- (setq result-tags (delete tag result-tags)))
|
||||
|
|
@ -511,22 +515,21 @@ and vice versa."
|
|||
;; REVERSE is specified.
|
||||
(interactive "P")
|
||||
(let (action-map)
|
||||
(dolist (binding notmuch-tagging-keys)
|
||||
(let* ((tag-function (case major-mode
|
||||
(pcase-dolist (`(,key ,tag ,name) notmuch-tagging-keys)
|
||||
(let* ((tag-function (cl-case major-mode
|
||||
(notmuch-search-mode #'notmuch-search-tag)
|
||||
(notmuch-show-mode #'notmuch-show-tag)
|
||||
(notmuch-tree-mode #'notmuch-tree-tag)))
|
||||
(key (first binding))
|
||||
(forward-tag-change (if (symbolp (second binding))
|
||||
(symbol-value (second binding))
|
||||
(second binding)))
|
||||
(tag (if (symbolp tag)
|
||||
(symbol-value tag)
|
||||
tag))
|
||||
(tag-change (if reverse
|
||||
(notmuch-tag-change-list forward-tag-change 't)
|
||||
forward-tag-change))
|
||||
(name (or (and (not (string= (third binding) ""))
|
||||
(third binding))
|
||||
(and (symbolp (second binding))
|
||||
(symbol-name (second binding)))))
|
||||
(notmuch-tag-change-list tag 't)
|
||||
tag))
|
||||
(name (or (and (not (string= name ""))
|
||||
name)
|
||||
(and (symbolp name)
|
||||
(symbol-name name))))
|
||||
(name-string (if name
|
||||
(if reverse (concat "Reverse " name)
|
||||
name)
|
||||
|
|
@ -546,7 +549,3 @@ and vice versa."
|
|||
;;
|
||||
|
||||
(provide 'notmuch-tag)
|
||||
|
||||
;; Local Variables:
|
||||
;; byte-compile-warnings: (not cl-functions)
|
||||
;; End:
|
||||
|
|
|
|||
|
|
@ -24,6 +24,8 @@
|
|||
|
||||
;;; Code:
|
||||
|
||||
(eval-when-compile (require 'cl-lib))
|
||||
|
||||
(require 'mail-parse)
|
||||
|
||||
(require 'notmuch-lib)
|
||||
|
|
@ -32,7 +34,6 @@
|
|||
(require 'notmuch-tag)
|
||||
(require 'notmuch-parser)
|
||||
|
||||
(eval-when-compile (require 'cl))
|
||||
(declare-function notmuch-search "notmuch" (&optional query oldest-first target-thread target-line))
|
||||
(declare-function notmuch-call-notmuch-process "notmuch" (&rest args))
|
||||
(declare-function notmuch-read-query "notmuch" (prompt))
|
||||
|
|
@ -721,10 +722,10 @@ found or nil if not."
|
|||
and call FUNCTION for side effects."
|
||||
(save-excursion
|
||||
(notmuch-tree-thread-top)
|
||||
(loop collect (funcall function)
|
||||
do (forward-line)
|
||||
while (and (notmuch-tree-get-message-properties)
|
||||
(not (notmuch-tree-get-prop :first))))))
|
||||
(cl-loop collect (funcall function)
|
||||
do (forward-line)
|
||||
while (and (notmuch-tree-get-message-properties)
|
||||
(not (notmuch-tree-get-prop :first))))))
|
||||
|
||||
(defun notmuch-tree-get-messages-ids-thread-search ()
|
||||
"Return a search string for all message ids of messages in the current thread."
|
||||
|
|
@ -905,10 +906,11 @@ message together with all its descendents."
|
|||
(defun notmuch-tree-insert-thread (thread depth tree-status)
|
||||
"Insert the collection of sibling sub-threads THREAD at depth DEPTH in the current forest."
|
||||
(let ((n (length thread)))
|
||||
(loop for tree in thread
|
||||
for count from 1 to n
|
||||
|
||||
do (notmuch-tree-insert-tree tree depth tree-status (eq count 1) (eq count n)))))
|
||||
(cl-loop for tree in thread
|
||||
for count from 1 to n
|
||||
do (notmuch-tree-insert-tree tree depth tree-status
|
||||
(eq count 1)
|
||||
(eq count n)))))
|
||||
|
||||
(defun notmuch-tree-insert-forest-thread (forest-thread)
|
||||
"Insert a single complete thread."
|
||||
|
|
|
|||
|
|
@ -65,7 +65,8 @@
|
|||
;;
|
||||
;;; Code:
|
||||
|
||||
(eval-when-compile (require 'cl))
|
||||
(eval-when-compile (require 'cl-lib))
|
||||
|
||||
(require 'mm-view)
|
||||
(require 'message)
|
||||
|
||||
|
|
@ -132,7 +133,7 @@ there will be called at other points of notmuch execution."
|
|||
(or (equal (car disposition) "attachment")
|
||||
(and (equal (car disposition) "inline")
|
||||
(assq 'filename disposition)))
|
||||
(incf count))))
|
||||
(cl-incf count))))
|
||||
mm-handle)
|
||||
count))
|
||||
|
||||
|
|
@ -429,14 +430,13 @@ character position of the beginning of each result that overlaps
|
|||
the region between points BEG and END. As a special case, if (=
|
||||
BEG END), FN will be applied to the result containing point
|
||||
BEG."
|
||||
|
||||
(lexical-let ((pos (notmuch-search-result-beginning beg))
|
||||
;; End must be a marker in case fn changes the
|
||||
;; text.
|
||||
(end (copy-marker end))
|
||||
;; Make sure we examine at least one result, even if
|
||||
;; (= beg end).
|
||||
(first t))
|
||||
(let ((pos (notmuch-search-result-beginning beg))
|
||||
;; End must be a marker in case fn changes the
|
||||
;; text.
|
||||
(end (copy-marker end))
|
||||
;; Make sure we examine at least one result, even if
|
||||
;; (= beg end).
|
||||
(first t))
|
||||
;; We have to be careful if the region extends beyond the results.
|
||||
;; In this case, pos could be null or there could be no result at
|
||||
;; pos.
|
||||
|
|
@ -478,10 +478,10 @@ is nil, include both matched and unmatched messages. If there are
|
|||
no messages in the region then return nil."
|
||||
(let ((query-list nil) (all (not only-matched)))
|
||||
(dolist (queries (notmuch-search-properties-in-region :query beg end))
|
||||
(when (first queries)
|
||||
(push (first queries) query-list))
|
||||
(when (and all (second queries))
|
||||
(push (second queries) query-list)))
|
||||
(when (car queries)
|
||||
(push (car queries) query-list))
|
||||
(when (and all (cadr queries))
|
||||
(push (cadr queries) query-list)))
|
||||
(when query-list
|
||||
(concat "(" (mapconcat 'identity query-list ") or (") ")"))))
|
||||
|
||||
|
|
@ -568,12 +568,11 @@ thread."
|
|||
"Prompt for tag changes for the current thread or region.
|
||||
|
||||
Returns (TAG-CHANGES REGION-BEGIN REGION-END)."
|
||||
(let* ((region (notmuch-interactive-region))
|
||||
(beg (first region)) (end (second region))
|
||||
(prompt (if (= beg end) "Tag thread" "Tag region")))
|
||||
(cons (notmuch-read-tag-changes
|
||||
(notmuch-search-get-tags-region beg end) prompt initial-input)
|
||||
region)))
|
||||
(pcase-let ((`(,beg ,end) (notmuch-interactive-region)))
|
||||
(list (notmuch-read-tag-changes (notmuch-search-get-tags-region beg end)
|
||||
(if (= beg end) "Tag thread" "Tag region")
|
||||
initial-input)
|
||||
beg end)))
|
||||
|
||||
(defun notmuch-search-tag (tag-changes &optional beg end only-matched)
|
||||
"Change tags for the currently selected thread or region.
|
||||
|
|
@ -891,12 +890,13 @@ See `notmuch-tag' for information on the format of TAG-CHANGES."
|
|||
(let* ((saved-search
|
||||
(let (longest
|
||||
(longest-length 0))
|
||||
(loop for tuple in notmuch-saved-searches
|
||||
if (let ((quoted-query (regexp-quote (notmuch-saved-search-get tuple :query))))
|
||||
(and (string-match (concat "^" quoted-query) query)
|
||||
(> (length (match-string 0 query))
|
||||
longest-length)))
|
||||
do (setq longest tuple))
|
||||
(cl-loop for tuple in notmuch-saved-searches
|
||||
if (let ((quoted-query
|
||||
(regexp-quote (notmuch-saved-search-get tuple :query))))
|
||||
(and (string-match (concat "^" quoted-query) query)
|
||||
(> (length (match-string 0 query))
|
||||
longest-length)))
|
||||
do (setq longest tuple))
|
||||
longest))
|
||||
(saved-search-name (notmuch-saved-search-get saved-search :name))
|
||||
(saved-search-query (notmuch-saved-search-get saved-search :query)))
|
||||
|
|
@ -917,7 +917,7 @@ See `notmuch-tag' for information on the format of TAG-CHANGES."
|
|||
"Read a notmuch-query from the minibuffer with completion.
|
||||
|
||||
PROMPT is the string to prompt with."
|
||||
(lexical-let*
|
||||
(let*
|
||||
((all-tags
|
||||
(mapcar (lambda (tag) (notmuch-escape-boolean-term tag))
|
||||
(process-lines notmuch-command "search" "--output=tags" "*")))
|
||||
|
|
@ -928,7 +928,7 @@ PROMPT is the string to prompt with."
|
|||
(mapcar (lambda (tag) (concat "is:" tag)) all-tags)
|
||||
(mapcar (lambda (mimetype) (concat "mimetype:" mimetype)) (mailcap-mime-types)))))
|
||||
(let ((keymap (copy-keymap minibuffer-local-map))
|
||||
(current-query (case major-mode
|
||||
(current-query (cl-case major-mode
|
||||
(notmuch-search-mode (notmuch-search-get-query))
|
||||
(notmuch-show-mode (notmuch-show-get-query))
|
||||
(notmuch-tree-mode (notmuch-tree-get-query))))
|
||||
|
|
@ -1114,9 +1114,9 @@ notmuch buffers exist, run `notmuch'."
|
|||
(bury-buffer))
|
||||
|
||||
;; Find the first notmuch buffer.
|
||||
(setq first (loop for buffer in (buffer-list)
|
||||
if (notmuch-interesting-buffer buffer)
|
||||
return buffer))
|
||||
(setq first (cl-loop for buffer in (buffer-list)
|
||||
if (notmuch-interesting-buffer buffer)
|
||||
return buffer))
|
||||
|
||||
(if first
|
||||
;; If the first one we found is any other than the starting
|
||||
|
|
|
|||
|
|
@ -177,7 +177,7 @@ test_emacs "(let ((notmuch-command \"$PWD/notmuch_fail\"))
|
|||
(let ((inhibit-read-only t)) (erase-buffer)))
|
||||
(condition-case err
|
||||
(notmuch-show \"*\")
|
||||
(error (message \"%s\" (second err))))
|
||||
(error (message \"%s\" (cadr err))))
|
||||
(notmuch-test-wait)
|
||||
(with-current-buffer \"*Messages*\"
|
||||
(test-output \"MESSAGES\"))
|
||||
|
|
|
|||
|
|
@ -1,3 +1,4 @@
|
|||
(require 'cl-lib)
|
||||
(require 'notmuch-mua)
|
||||
|
||||
(defun attachment-check-test (&optional fn)
|
||||
|
|
@ -12,7 +13,8 @@ Return `t' if the message would be sent, otherwise `nil'"
|
|||
(condition-case nil
|
||||
;; Force `y-or-n-p' to always return `nil', as if the user
|
||||
;; pressed "n".
|
||||
(letf (((symbol-function 'y-or-n-p) (lambda (&rest args) nil)))
|
||||
(cl-letf (((symbol-function 'y-or-n-p)
|
||||
(lambda (&rest args) nil)))
|
||||
(notmuch-mua-attachment-check)
|
||||
t)
|
||||
('error nil))
|
||||
|
|
|
|||
|
|
@ -20,7 +20,7 @@
|
|||
;;
|
||||
;; Authors: Dmitry Kurochkin <dmitry.kurochkin@gmail.com>
|
||||
|
||||
(require 'cl) ;; This code is generally used uncompiled.
|
||||
(require 'cl-lib)
|
||||
|
||||
;; `read-file-name' by default uses `completing-read' function to read
|
||||
;; user input. It does not respect `standard-input' variable which we
|
||||
|
|
@ -116,10 +116,10 @@ nothing."
|
|||
(defadvice notmuch-search-process-filter (around pessimal activate disable)
|
||||
"Feed notmuch-search-process-filter one character at a time."
|
||||
(let ((string (ad-get-arg 1)))
|
||||
(loop for char across string
|
||||
do (progn
|
||||
(ad-set-arg 1 (char-to-string char))
|
||||
ad-do-it))))
|
||||
(cl-loop for char across string
|
||||
do (progn
|
||||
(ad-set-arg 1 (char-to-string char))
|
||||
ad-do-it))))
|
||||
|
||||
(defun notmuch-test-mark-links ()
|
||||
"Enclose links in the current buffer with << and >>."
|
||||
|
|
@ -162,10 +162,10 @@ nothing."
|
|||
;; reporting differing elements of OUTPUT and EXPECTED
|
||||
;; pairwise. This is expected to make analysis of failures
|
||||
;; simpler.
|
||||
(apply #'concat (loop for o in output
|
||||
for e in expected
|
||||
if (not (equal o e))
|
||||
collect (notmuch-test-report-unexpected o e))))
|
||||
(apply #'concat (cl-loop for o in output
|
||||
for e in expected
|
||||
if (not (equal o e))
|
||||
collect (notmuch-test-report-unexpected o e))))
|
||||
|
||||
(t
|
||||
(notmuch-test-report-unexpected output expected)))))
|
||||
|
|
|
|||
Loading…
Reference in a new issue