--- /dev/null
+Return-Path: <dme@dme.org>\r
+X-Original-To: notmuch@notmuchmail.org\r
+Delivered-To: notmuch@notmuchmail.org\r
+Received: from localhost (localhost [127.0.0.1])\r
+ by olra.theworths.org (Postfix) with ESMTP id 56531409C88\r
+ for <notmuch@notmuchmail.org>; Wed, 19 May 2010 01:54:47 -0700 (PDT)\r
+X-Virus-Scanned: Debian amavisd-new at olra.theworths.org\r
+X-Spam-Flag: NO\r
+X-Spam-Score: -1.9\r
+X-Spam-Level: \r
+X-Spam-Status: No, score=-1.9 tagged_above=-999 required=5\r
+ tests=[BAYES_00=-1.9, RCVD_IN_DNSWL_NONE=-0.0001] autolearn=ham\r
+Received: from olra.theworths.org ([127.0.0.1])\r
+ by localhost (olra.theworths.org [127.0.0.1]) (amavisd-new, port 10024)\r
+ with ESMTP id WFog5lHzk+XU for <notmuch@notmuchmail.org>;\r
+ Wed, 19 May 2010 01:54:34 -0700 (PDT)\r
+Received: from mail-ew0-f213.google.com (mail-ew0-f213.google.com\r
+ [209.85.219.213])\r
+ by olra.theworths.org (Postfix) with ESMTP id 851CC418C3C\r
+ for <notmuch@notmuchmail.org>; Wed, 19 May 2010 01:53:46 -0700 (PDT)\r
+Received: by mail-ew0-f213.google.com with SMTP id 5so1814158ewy.0\r
+ for <notmuch@notmuchmail.org>; Wed, 19 May 2010 01:53:46 -0700 (PDT)\r
+Received: by 10.213.75.139 with SMTP id y11mr3533814ebj.63.1274259226109;\r
+ Wed, 19 May 2010 01:53:46 -0700 (PDT)\r
+Received: from ut.hh.sledj.net (host83-217-165-81.dsl.vispa.com\r
+ [83.217.165.81])\r
+ by mx.google.com with ESMTPS id 15sm3497509ewy.12.2010.05.19.01.53.43\r
+ (version=TLSv1/SSLv3 cipher=RC4-MD5);\r
+ Wed, 19 May 2010 01:53:45 -0700 (PDT)\r
+Received: by ut.hh.sledj.net (Postfix, from userid 1000)\r
+ id 12EAE5940B0; Wed, 19 May 2010 08:03:45 +0100 (BST)\r
+From: David Edmondson <dme@dme.org>\r
+To: notmuch@notmuchmail.org\r
+Subject: [PATCH 09/13] emacs: Avoid runtime use of `cl'.\r
+Date: Wed, 19 May 2010 08:03:36 +0100\r
+Message-Id: <1274252620-1249-10-git-send-email-dme@dme.org>\r
+X-Mailer: git-send-email 1.7.1\r
+In-Reply-To: <1274252620-1249-1-git-send-email-dme@dme.org>\r
+References: <1274252620-1249-1-git-send-email-dme@dme.org>\r
+X-BeenThere: notmuch@notmuchmail.org\r
+X-Mailman-Version: 2.1.13\r
+Precedence: list\r
+List-Id: "Use and development of the notmuch mail system."\r
+ <notmuch.notmuchmail.org>\r
+List-Unsubscribe: <http://notmuchmail.org/mailman/options/notmuch>,\r
+ <mailto:notmuch-request@notmuchmail.org?subject=unsubscribe>\r
+List-Archive: <http://notmuchmail.org/pipermail/notmuch>\r
+List-Post: <mailto:notmuch@notmuchmail.org>\r
+List-Help: <mailto:notmuch-request@notmuchmail.org?subject=help>\r
+List-Subscribe: <http://notmuchmail.org/mailman/listinfo/notmuch>,\r
+ <mailto:notmuch-request@notmuchmail.org?subject=subscribe>\r
+X-List-Received-Date: Wed, 19 May 2010 08:54:47 -0000\r
+\r
+The GNU Emacs Lisp Reference Manual section D.1 says:\r
+\r
+> * Please don't require the cl package of Common Lisp extensions at\r
+> run time. Use of this package is optional, and it is not part of\r
+> the standard Emacs namespace. If your package loads cl at run time,\r
+> that could cause name clashes for users who don't use that package.\r
+>\r
+> However, there is no problem with using the cl package at compile\r
+> time, with (eval-when-compile (require 'cl)). That's sufficient for\r
+> using the macros in the cl package, because the compiler expands\r
+> them before generating the byte-code.\r
+\r
+Follow this advice, requiring the following changes where `cl' was\r
+used at runtime:\r
+\r
+- replace `rassoc-if' in `notmuch-search-buffer-title' with the `loop'\r
+ macro and inline code. At the same time find the longest prefix\r
+ which matches the query rather than simply the last,\r
+- replace `union', `intersection' and `set-difference' in\r
+ `notmuch-show-add-tag' and `notmuch-show-remove-tag' with local code\r
+ to calculate the result of adding and removing a list of tags from\r
+ another list of tags.\r
+---\r
+ emacs/notmuch-hello.el | 2 +-\r
+ emacs/notmuch-show.el | 54 +++++++++++++++++++++++++++++++++++------------\r
+ emacs/notmuch.el | 16 +++++++++----\r
+ 3 files changed, 52 insertions(+), 20 deletions(-)\r
+\r
+diff --git a/emacs/notmuch-hello.el b/emacs/notmuch-hello.el\r
+index acf40bc..538785f 100644\r
+--- a/emacs/notmuch-hello.el\r
++++ b/emacs/notmuch-hello.el\r
+@@ -19,9 +19,9 @@\r
+ ;;\r
+ ;; Authors: David Edmondson <dme@dme.org>\r
+ \r
++(eval-when-compile (require 'cl))\r
+ (require 'widget)\r
+ (require 'wid-edit) ; For `widget-forward'.\r
+-(require 'cl)\r
+ \r
+ (require 'notmuch-lib)\r
+ (require 'notmuch-mua)\r
+diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el\r
+index 4b1baf3..ff1a7a7 100644\r
+--- a/emacs/notmuch-show.el\r
++++ b/emacs/notmuch-show.el\r
+@@ -21,7 +21,7 @@\r
+ ;; Authors: Carl Worth <cworth@cworth.org>\r
+ ;; David Edmondson <dme@dme.org>\r
+ \r
+-(require 'cl)\r
++(eval-when-compile (require 'cl))\r
+ (require 'mm-view)\r
+ (require 'message)\r
+ (require 'mm-decode)\r
+@@ -908,29 +908,55 @@ to stdout or stderr will appear in the *Messages* buffer."\r
+ (list command " < "\r
+ (shell-quote-argument (notmuch-show-get-filename)))))\r
+ \r
++(defun notmuch-show-add-tags-worker (current-tags add-tags)\r
++ "Add to `current-tags' with any tags from `add-tags' not\r
++currently present and return the result."\r
++ (let ((result-tags (copy-seq current-tags)))\r
++ (mapc (lambda (add-tag)\r
++ (unless (member add-tag current-tags)\r
++ (setq result-tags (push add-tag result-tags))))\r
++ add-tags)\r
++ (sort result-tags 'string<)))\r
++\r
++(defun notmuch-show-del-tags-worker (current-tags del-tags)\r
++ "Remove any tags in `del-tags' from `current-tags' and return\r
++the result."\r
++ (let ((result-tags (copy-seq current-tags)))\r
++ (mapc (lambda (del-tag)\r
++ (setq result-tags (delete del-tag result-tags)))\r
++ del-tags)\r
++ result-tags))\r
++\r
+ (defun notmuch-show-add-tag (&rest toadd)\r
+ "Add a tag to the current message."\r
+ (interactive\r
+ (list (notmuch-select-tag-with-completion "Tag to add: ")))\r
+- (apply 'notmuch-call-notmuch-process\r
+- (append (cons "tag"\r
+- (mapcar (lambda (s) (concat "+" s)) toadd))\r
+- (cons (notmuch-show-get-message-id) nil)))\r
+- (notmuch-show-set-tags (sort (union toadd (notmuch-show-get-tags) :test 'string=) 'string<)))\r
++\r
++ (let* ((current-tags (notmuch-show-get-tags))\r
++ (new-tags (notmuch-show-add-tags-worker current-tags toadd)))\r
++\r
++ (unless (equal current-tags new-tags)\r
++ (apply 'notmuch-call-notmuch-process\r
++ (append (cons "tag"\r
++ (mapcar (lambda (s) (concat "+" s)) toadd))\r
++ (cons (notmuch-show-get-message-id) nil)))\r
++ (notmuch-show-set-tags new-tags))))\r
+ \r
+ (defun notmuch-show-remove-tag (&rest toremove)\r
+ "Remove a tag from the current message."\r
+ (interactive\r
+ (list (notmuch-select-tag-with-completion\r
+ "Tag to remove: " (notmuch-show-get-message-id))))\r
+- (let ((tags (notmuch-show-get-tags)))\r
+- (if (intersection tags toremove :test 'string=)\r
+- (progn\r
+- (apply 'notmuch-call-notmuch-process\r
+- (append (cons "tag"\r
+- (mapcar (lambda (s) (concat "-" s)) toremove))\r
+- (cons (notmuch-show-get-message-id) nil)))\r
+- (notmuch-show-set-tags (sort (set-difference tags toremove :test 'string=) 'string<))))))\r
++\r
++ (let* ((current-tags (notmuch-show-get-tags))\r
++ (new-tags (notmuch-show-del-tags-worker current-tags toremove)))\r
++\r
++ (unless (equal current-tags new-tags)\r
++ (apply 'notmuch-call-notmuch-process\r
++ (append (cons "tag"\r
++ (mapcar (lambda (s) (concat "-" s)) toremove))\r
++ (cons (notmuch-show-get-message-id) nil)))\r
++ (notmuch-show-set-tags new-tags))))\r
+ \r
+ (defun notmuch-show-toggle-headers ()\r
+ "Toggle the visibility of the current message headers."\r
+diff --git a/emacs/notmuch.el b/emacs/notmuch.el\r
+index 7c9c028..c2fefe5 100644\r
+--- a/emacs/notmuch.el\r
++++ b/emacs/notmuch.el\r
+@@ -47,7 +47,7 @@\r
+ ; kudos: Notmuch list <notmuch@notmuchmail.org> (subscription is not\r
+ ; required, but is available from http://notmuchmail.org).\r
+ \r
+-(require 'cl)\r
++(eval-when-compile (require 'cl))\r
+ (require 'mm-view)\r
+ (require 'message)\r
+ \r
+@@ -712,10 +712,16 @@ characters as well as `_.+-'.\r
+ \r
+ (defun notmuch-search-buffer-title (query)\r
+ "Returns the title for a buffer with notmuch search results."\r
+- (let* ((saved-search (rassoc-if (lambda (key)\r
+- (string-match (concat "^" (regexp-quote key))\r
+- query))\r
+- (reverse (notmuch-saved-searches))))\r
++ (let* ((saved-search\r
++ (let (longest\r
++ (longest-length 0))\r
++ (loop for tuple in notmuch-saved-searches\r
++ if (let ((quoted-query (regexp-quote (cdr tuple))))\r
++ (and (string-match (concat "^" quoted-query) query)\r
++ (> (length (match-string 0 query))\r
++ longest-length)))\r
++ do (setq longest tuple))\r
++ longest))\r
+ (saved-search-name (car saved-search))\r
+ (saved-search-query (cdr saved-search)))\r
+ (cond ((and saved-search (equal saved-search-query query))\r
+-- \r
+1.7.1\r
+\r
projects / notmuch-archives.git / commitdiff