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:
David Edmondson 2010-04-29 11:33:36 +01:00 committed by Carl Worth
parent b67c3ed609
commit c506e1034b
3 changed files with 52 additions and 20 deletions

View file

@ -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)

View file

@ -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."

View file

@ -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))