mirror of
https://git.notmuchmail.org/git/notmuch
synced 2024-11-25 04:18:08 +01:00
emacs: Avoid runtime use of `cl'.
The GNU Emacs Lisp Reference Manual section D.1 says: > * Please don't require the cl package of Common Lisp extensions at > run time. Use of this package is optional, and it is not part of > the standard Emacs namespace. If your package loads cl at run time, > that could cause name clashes for users who don't use that package. > > However, there is no problem with using the cl package at compile > time, with (eval-when-compile (require 'cl)). That's sufficient for > using the macros in the cl package, because the compiler expands > them before generating the byte-code. Follow this advice, requiring the following changes where `cl' was used at runtime: - replace `rassoc-if' in `notmuch-search-buffer-title' with the `loop' macro and inline code. At the same time find the longest prefix which matches the query rather than simply the last, - replace `union', `intersection' and `set-difference' in `notmuch-show-add-tag' and `notmuch-show-remove-tag' with local code to calculate the result of adding and removing a list of tags from another list of tags.
This commit is contained in:
parent
b67c3ed609
commit
c506e1034b
3 changed files with 52 additions and 20 deletions
|
@ -19,9 +19,9 @@
|
||||||
;;
|
;;
|
||||||
;; Authors: David Edmondson <dme@dme.org>
|
;; Authors: David Edmondson <dme@dme.org>
|
||||||
|
|
||||||
|
(eval-when-compile (require 'cl))
|
||||||
(require 'widget)
|
(require 'widget)
|
||||||
(require 'wid-edit) ; For `widget-forward'.
|
(require 'wid-edit) ; For `widget-forward'.
|
||||||
(require 'cl)
|
|
||||||
|
|
||||||
(require 'notmuch-lib)
|
(require 'notmuch-lib)
|
||||||
(require 'notmuch-mua)
|
(require 'notmuch-mua)
|
||||||
|
|
|
@ -21,7 +21,7 @@
|
||||||
;; Authors: Carl Worth <cworth@cworth.org>
|
;; Authors: Carl Worth <cworth@cworth.org>
|
||||||
;; David Edmondson <dme@dme.org>
|
;; David Edmondson <dme@dme.org>
|
||||||
|
|
||||||
(require 'cl)
|
(eval-when-compile (require 'cl))
|
||||||
(require 'mm-view)
|
(require 'mm-view)
|
||||||
(require 'message)
|
(require 'message)
|
||||||
(require 'mm-decode)
|
(require 'mm-decode)
|
||||||
|
@ -942,29 +942,55 @@ than only the current message."
|
||||||
(concat command " < " (shell-quote-argument (notmuch-show-get-filename)))))
|
(concat command " < " (shell-quote-argument (notmuch-show-get-filename)))))
|
||||||
(start-process-shell-command "notmuch-pipe-command" "*notmuch-pipe*" shell-command)))
|
(start-process-shell-command "notmuch-pipe-command" "*notmuch-pipe*" shell-command)))
|
||||||
|
|
||||||
|
(defun notmuch-show-add-tags-worker (current-tags add-tags)
|
||||||
|
"Add to `current-tags' with any tags from `add-tags' not
|
||||||
|
currently present and return the result."
|
||||||
|
(let ((result-tags (copy-seq current-tags)))
|
||||||
|
(mapc (lambda (add-tag)
|
||||||
|
(unless (member add-tag current-tags)
|
||||||
|
(setq result-tags (push add-tag result-tags))))
|
||||||
|
add-tags)
|
||||||
|
(sort result-tags 'string<)))
|
||||||
|
|
||||||
|
(defun notmuch-show-del-tags-worker (current-tags del-tags)
|
||||||
|
"Remove any tags in `del-tags' from `current-tags' and return
|
||||||
|
the result."
|
||||||
|
(let ((result-tags (copy-seq current-tags)))
|
||||||
|
(mapc (lambda (del-tag)
|
||||||
|
(setq result-tags (delete del-tag result-tags)))
|
||||||
|
del-tags)
|
||||||
|
result-tags))
|
||||||
|
|
||||||
(defun notmuch-show-add-tag (&rest toadd)
|
(defun notmuch-show-add-tag (&rest toadd)
|
||||||
"Add a tag to the current message."
|
"Add a tag to the current message."
|
||||||
(interactive
|
(interactive
|
||||||
(list (notmuch-select-tag-with-completion "Tag to add: ")))
|
(list (notmuch-select-tag-with-completion "Tag to add: ")))
|
||||||
|
|
||||||
|
(let* ((current-tags (notmuch-show-get-tags))
|
||||||
|
(new-tags (notmuch-show-add-tags-worker current-tags toadd)))
|
||||||
|
|
||||||
|
(unless (equal current-tags new-tags)
|
||||||
(apply 'notmuch-call-notmuch-process
|
(apply 'notmuch-call-notmuch-process
|
||||||
(append (cons "tag"
|
(append (cons "tag"
|
||||||
(mapcar (lambda (s) (concat "+" s)) toadd))
|
(mapcar (lambda (s) (concat "+" s)) toadd))
|
||||||
(cons (notmuch-show-get-message-id) nil)))
|
(cons (notmuch-show-get-message-id) nil)))
|
||||||
(notmuch-show-set-tags (sort (union toadd (notmuch-show-get-tags) :test 'string=) 'string<)))
|
(notmuch-show-set-tags new-tags))))
|
||||||
|
|
||||||
(defun notmuch-show-remove-tag (&rest toremove)
|
(defun notmuch-show-remove-tag (&rest toremove)
|
||||||
"Remove a tag from the current message."
|
"Remove a tag from the current message."
|
||||||
(interactive
|
(interactive
|
||||||
(list (notmuch-select-tag-with-completion
|
(list (notmuch-select-tag-with-completion
|
||||||
"Tag to remove: " (notmuch-show-get-message-id))))
|
"Tag to remove: " (notmuch-show-get-message-id))))
|
||||||
(let ((tags (notmuch-show-get-tags)))
|
|
||||||
(if (intersection tags toremove :test 'string=)
|
(let* ((current-tags (notmuch-show-get-tags))
|
||||||
(progn
|
(new-tags (notmuch-show-del-tags-worker current-tags toremove)))
|
||||||
|
|
||||||
|
(unless (equal current-tags new-tags)
|
||||||
(apply 'notmuch-call-notmuch-process
|
(apply 'notmuch-call-notmuch-process
|
||||||
(append (cons "tag"
|
(append (cons "tag"
|
||||||
(mapcar (lambda (s) (concat "-" s)) toremove))
|
(mapcar (lambda (s) (concat "-" s)) toremove))
|
||||||
(cons (notmuch-show-get-message-id) nil)))
|
(cons (notmuch-show-get-message-id) nil)))
|
||||||
(notmuch-show-set-tags (sort (set-difference tags toremove :test 'string=) 'string<))))))
|
(notmuch-show-set-tags new-tags))))
|
||||||
|
|
||||||
(defun notmuch-show-toggle-headers ()
|
(defun notmuch-show-toggle-headers ()
|
||||||
"Toggle the visibility of the current message headers."
|
"Toggle the visibility of the current message headers."
|
||||||
|
|
|
@ -47,7 +47,7 @@
|
||||||
; kudos: Notmuch list <notmuch@notmuchmail.org> (subscription is not
|
; kudos: Notmuch list <notmuch@notmuchmail.org> (subscription is not
|
||||||
; required, but is available from http://notmuchmail.org).
|
; required, but is available from http://notmuchmail.org).
|
||||||
|
|
||||||
(require 'cl)
|
(eval-when-compile (require 'cl))
|
||||||
(require 'mm-view)
|
(require 'mm-view)
|
||||||
(require 'message)
|
(require 'message)
|
||||||
|
|
||||||
|
@ -741,10 +741,16 @@ characters as well as `_.+-'.
|
||||||
|
|
||||||
(defun notmuch-search-buffer-title (query)
|
(defun notmuch-search-buffer-title (query)
|
||||||
"Returns the title for a buffer with notmuch search results."
|
"Returns the title for a buffer with notmuch search results."
|
||||||
(let* ((saved-search (rassoc-if (lambda (key)
|
(let* ((saved-search
|
||||||
(string-match (concat "^" (regexp-quote key))
|
(let (longest
|
||||||
query))
|
(longest-length 0))
|
||||||
(reverse (notmuch-saved-searches))))
|
(loop for tuple in notmuch-saved-searches
|
||||||
|
if (let ((quoted-query (regexp-quote (cdr tuple))))
|
||||||
|
(and (string-match (concat "^" quoted-query) query)
|
||||||
|
(> (length (match-string 0 query))
|
||||||
|
longest-length)))
|
||||||
|
do (setq longest tuple))
|
||||||
|
longest))
|
||||||
(saved-search-name (car saved-search))
|
(saved-search-name (car saved-search))
|
||||||
(saved-search-query (cdr saved-search)))
|
(saved-search-query (cdr saved-search)))
|
||||||
(cond ((and saved-search (equal saved-search-query query))
|
(cond ((and saved-search (equal saved-search-query query))
|
||||||
|
|
Loading…
Reference in a new issue