;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
+
(require 'notmuch-lib)
(defvar notmuch-company-last-prefix nil)
(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 ".*")
"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.
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
+
(require 'widget)
(require 'wid-edit) ; For `widget-forward'.
((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.
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)
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
(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
(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)))
"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))
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile
+ (require 'cl-lib)
+ (require 'pcase))
(require 'notmuch-lib)
(require 'notmuch-hello)
(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)))))
;; 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)
"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"
;;; Code:
+(require 'cl-lib)
+
(require 'mm-util)
(require 'mm-view)
(require 'mm-decode)
-(require 'cl)
+
(require 'notmuch-compat)
(unless (require 'notmuch-version nil t)
(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))
;; 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.
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
(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
(provide 'notmuch-lib)
-;; Local Variables:
-;; byte-compile-warnings: (not cl-functions)
-;; End:
-
;;; notmuch-lib.el ends here
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
+
(require 'message)
(require 'notmuch-lib)
(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)))))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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
;;; Code:
+(eval-when-compile (require 'cl-lib))
+
(require 'message)
(require 'mm-view)
(require 'format-spec)
(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" ())
;; 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)
(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
;; 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)
;; 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)
;; 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.
(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")
;;; Code:
-(require 'cl)
+(eval-when-compile (require 'cl-lib))
(defun notmuch-sexp-create-parser ()
"Return a new streaming S-expression parser.
;; 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) ?\()
(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
(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
(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)
(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
(provide 'notmuch-parser)
-;; Local Variables:
-;; byte-compile-warnings: (not cl-functions)
-;; End:
-
;;; notmuch-parser.el ends here
"notmuch"
%VERSION%
"Emacs based front-end (MUA) for notmuch"
- '((emacs "24")))
+ '((emacs "24")
+ (cl-lib "0.6.1")))
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile
+ (require 'cl-lib)
+ (require 'pcase))
+
(require 'mm-view)
(require 'message)
(require 'mm-decode)
(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'.
;; 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.
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
(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
;; 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))))
;; 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))
(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"
;; 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
(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
;; 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))
(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)))))
(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))
;; 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)
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.
(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 ()
;;; Code:
;;
-(require 'cl)
+(require 'cl-lib)
+(eval-when-compile
+ (require 'pcase))
+
(require 'crm)
+
(require 'notmuch-lib)
(declare-function notmuch-search-tag "notmuch" tag-changes)
(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."
(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
(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)))
;; 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)
;;
(provide 'notmuch-tag)
-
-;; Local Variables:
-;; byte-compile-warnings: (not cl-functions)
-;; End:
;;; Code:
+(eval-when-compile (require 'cl-lib))
+
(require 'mail-parse)
(require 'notmuch-lib)
(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))
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."
(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."
;;
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
+
(require 'mm-view)
(require 'message)
(or (equal (car disposition) "attachment")
(and (equal (car disposition) "inline")
(assq 'filename disposition)))
- (incf count))))
+ (cl-incf count))))
mm-handle)
count))
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.
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 (") ")"))))
"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.
(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)))
"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" "*")))
(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))))
(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
(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\"))
+(require 'cl-lib)
(require 'notmuch-mua)
(defun attachment-check-test (&optional fn)
(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))
;;
;; 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
(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 >>."
;; 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)))))
projects / notmuch / commitdiff