Re: [PATCH] emacs: wash: make word-wrap bound message width

[notmuch-archives.git] / 81 / 9b7eef451685cf4486508e7ae101a79b1179e6

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 6794B431FC1\r
        for <notmuch@notmuchmail.org>; Thu, 29 Apr 2010 03:33:21 -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] 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 99iVZeFFCXRt for <notmuch@notmuchmail.org>;\r
        Thu, 29 Apr 2010 03:33:20 -0700 (PDT)\r
Received: from mail-ww0-f53.google.com (mail-ww0-f53.google.com\r
 [74.125.82.53])        by olra.theworths.org (Postfix) with ESMTP id EC7734196F0       for\r
 <notmuch@notmuchmail.org>; Thu, 29 Apr 2010 03:33:19 -0700 (PDT)\r
Received: by wwe15 with SMTP id 15so603711wwe.26\r
        for <notmuch@notmuchmail.org>; Thu, 29 Apr 2010 03:33:19 -0700 (PDT)\r
Received: by 10.216.93.2 with SMTP id k2mr4509734wef.56.1272537198082;\r
        Thu, 29 Apr 2010 03:33:18 -0700 (PDT)\r
Received: from ut.hh.sledj.net (gmp-ea-fw-1b.sun.com [192.18.8.1])\r
        by mx.google.com with ESMTPS id t2sm1264584wbc.8.2010.04.29.03.33.16\r
        (version=TLSv1/SSLv3 cipher=RC4-MD5);\r
        Thu, 29 Apr 2010 03:33:17 -0700 (PDT)\r
Received: by ut.hh.sledj.net (Postfix, from userid 1000)\r
        id E3D8D59411F; Thu, 29 Apr 2010 11:33:37 +0100 (BST)\r
From: David Edmondson <dme@dme.org>\r
To: notmuch@notmuchmail.org\r
Subject: [PATCH] emacs: Avoid runtime use of `cl'.\r
Date: Thu, 29 Apr 2010 11:33:36 +0100\r
Message-Id: <1272537216-2635-1-git-send-email-dme@dme.org>\r
X-Mailer: git-send-email 1.7.0\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: Thu, 29 Apr 2010 10:33:21 -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
\r
This change requires some careful review, particularly for the code\r
which manipulates sets 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.0\r
\r