a3/eb1d47e19ce4b52eec33eaa662a2c053f3255d

   1 Return-Path: <dme@dme.org>\r
   2 X-Original-To: notmuch@notmuchmail.org\r
   3 Delivered-To: notmuch@notmuchmail.org\r
   4 Received: from localhost (localhost [127.0.0.1])\r
   5         by olra.theworths.org (Postfix) with ESMTP id 1C07D41A540\r
   6         for <notmuch@notmuchmail.org>; Thu, 25 Nov 2010 03:03:26 -0800 (PST)\r
   7 X-Virus-Scanned: Debian amavisd-new at olra.theworths.org\r
   8 X-Spam-Flag: NO\r
   9 X-Spam-Score: 0\r
  10 X-Spam-Level: \r
  11 X-Spam-Status: No, score=0 tagged_above=-999 required=5\r
  12         tests=[RCVD_IN_DNSWL_NONE=-0.0001] autolearn=disabled\r
  13 Received: from olra.theworths.org ([127.0.0.1])\r
  14         by localhost (olra.theworths.org [127.0.0.1]) (amavisd-new, port 10024)\r
  15         with ESMTP id RzJRJUdIwra5 for <notmuch@notmuchmail.org>;\r
  16         Thu, 25 Nov 2010 03:03:24 -0800 (PST)\r
  17 Received: from mail-wy0-f181.google.com (mail-wy0-f181.google.com\r
  18         [74.125.82.181])\r
  19         by olra.theworths.org (Postfix) with ESMTP id 9A4A3431FB6\r
  20         for <notmuch@notmuchmail.org>; Thu, 25 Nov 2010 03:03:24 -0800 (PST)\r
  21 Received: by mail-wy0-f181.google.com with SMTP id 22so827352wyf.26\r
  22         for <notmuch@notmuchmail.org>; Thu, 25 Nov 2010 03:03:24 -0800 (PST)\r
  23 Received: by 10.216.3.130 with SMTP id 2mr651683weh.3.1290683004054;\r
  24         Thu, 25 Nov 2010 03:03:24 -0800 (PST)\r
  25 Received: from ut.hh.sledj.net (host81-149-164-25.in-addr.btopenworld.com\r
  26         [81.149.164.25])\r
  27         by mx.google.com with ESMTPS id w41sm254090weq.8.2010.11.25.03.03.18\r
  28         (version=TLSv1/SSLv3 cipher=RC4-MD5);\r
  29         Thu, 25 Nov 2010 03:03:19 -0800 (PST)\r
  30 Received: by ut.hh.sledj.net (Postfix, from userid 1000)\r
  31         id 9601B59405B; Thu, 25 Nov 2010 10:59:19 +0000 (GMT)\r
  32 From: David Edmondson <dme@dme.org>\r
  33 To: notmuch@notmuchmail.org\r
  34 Subject: [PATCH 2/3] emacs: Fix Fcc generation.\r
  35 Date: Thu, 25 Nov 2010 10:59:09 +0000\r
  36 Message-Id: <1290682750-30283-2-git-send-email-dme@dme.org>\r
  37 X-Mailer: git-send-email 1.7.2.3\r
  38 In-Reply-To: <1290632444-10046-1-git-send-email-cworth@cworth.org>\r
  39 References: <1290632444-10046-1-git-send-email-cworth@cworth.org>\r
  40 X-BeenThere: notmuch@notmuchmail.org\r
  41 X-Mailman-Version: 2.1.13\r
  42 Precedence: list\r
  43 List-Id: "Use and development of the notmuch mail system."\r
  44         <notmuch.notmuchmail.org>\r
  45 List-Unsubscribe: <http://notmuchmail.org/mailman/options/notmuch>,\r
  46         <mailto:notmuch-request@notmuchmail.org?subject=unsubscribe>\r
  47 List-Archive: <http://notmuchmail.org/pipermail/notmuch>\r
  48 List-Post: <mailto:notmuch@notmuchmail.org>\r
  49 List-Help: <mailto:notmuch-request@notmuchmail.org?subject=help>\r
  50 List-Subscribe: <http://notmuchmail.org/mailman/listinfo/notmuch>,\r
  51         <mailto:notmuch-request@notmuchmail.org?subject=subscribe>\r
  52 X-List-Received-Date: Thu, 25 Nov 2010 11:03:26 -0000\r
  53 \r
  54 The previous code did not correctly identify an old configuration and,\r
  55 as a consequence, broke new configurations.\r
  56 \r
  57 Minor re-arrangement to assist testing.\r
  58 ---\r
  59  emacs/notmuch-maildir-fcc.el |  107 +++++++++++++++++++++---------------------\r
  60  1 files changed, 53 insertions(+), 54 deletions(-)\r
  61 \r
  62 diff --git a/emacs/notmuch-maildir-fcc.el b/emacs/notmuch-maildir-fcc.el\r
  63 index e5e0549..349c4d9 100644\r
  64 --- a/emacs/notmuch-maildir-fcc.el\r
  65 +++ b/emacs/notmuch-maildir-fcc.el\r
  66 @@ -70,6 +70,31 @@ yet when sending a mail."\r
  67      ;; add a hook to actually insert the Fcc header when sending\r
  68      (add-hook 'message-header-setup-hook 'notmuch-fcc-header-setup))\r
  69  \r
  70 +(defun notmuch-fcc-determine-folder (configuration from)\r
  71 +  "Determine the correct folder to be used for Fcc."\r
  72 +\r
  73 +  (cond\r
  74 +   ((stringp configuration)\r
  75 +    configuration)\r
  76 +\r
  77 +   ((and (listp configuration)\r
  78 +        (stringp (car configuration)))\r
  79 +    ;; Old style - no longer works.\r
  80 +    (error "Invalid Fcc configuration (old style)"))\r
  81 +\r
  82 +   ((listp configuration)\r
  83 +    (let ((match\r
  84 +          (catch 'first-match\r
  85 +            (dolist (re-folder configuration)\r
  86 +              (when (string-match-p (car re-folder) from)\r
  87 +                (throw 'first-match re-folder))))))\r
  88 +      (if match\r
  89 +         (cdr match)\r
  90 +       nil)))\r
  91 +   \r
  92 +   (t\r
  93 +    (error "Invalid Fcc configuration (neither string nor list)"))))\r
  94 +\r
  95  (defun notmuch-fcc-header-setup ()\r
  96    "Add an Fcc header to the current message buffer.\r
  97  \r
  98 @@ -77,63 +102,37 @@ Can be added to `message-send-hook' and will set the Fcc header\r
  99  based on the values of `notmuch-fcc-dirs'. An existing Fcc header\r
 100  will NOT be removed or replaced."\r
 101  \r
 102 -  (let ((subdir\r
 103 -        (cond\r
 104 -         ((or (not notmuch-fcc-dirs)\r
 105 -              (message-fetch-field "Fcc"))\r
 106 -          ;; Nothing set or an existing header.\r
 107 -          nil)\r
 108 -\r
 109 -         ((stringp notmuch-fcc-dirs)\r
 110 -          notmuch-fcc-dirs)\r
 111 -\r
 112 -         ((and (listp notmuch-fcc-dirs)\r
 113 -               (= 1 (length (car notmuch-fcc-dirs))))\r
 114 -          ;; Old style - no longer works.\r
 115 -          (error "Invalid `notmuch-fcc-dirs' setting (old style)"))\r
 116 -\r
 117 -         ((listp notmuch-fcc-dirs)\r
 118 -          (let* ((from (message-fetch-field "From"))\r
 119 -                 (match\r
 120 -                  (catch 'first-match\r
 121 -                    (dolist (re-folder notmuch-fcc-dirs)\r
 122 -                      (when (string-match-p (car re-folder) from)\r
 123 -                        (throw 'first-match re-folder))))))\r
 124 -            (if match\r
 125 -                (cdr match)\r
 126 -              (message "No Fcc header added.")\r
 127 -              nil)))\r
 128 -\r
 129 -         (t\r
 130 -          (error "Invalid `notmuch-fcc-dirs' setting (neither string nor list)")))))\r
 131 -\r
 132 -    (when subdir\r
 133 -      (message-add-header\r
 134 -       (concat "Fcc: "\r
 135 -              ;; If the resulting directory is not an absolute path,\r
 136 -              ;; prepend the standard notmuch database path.\r
 137 -              (if (= (elt subdir 0) ?/)\r
 138 -                  subdir\r
 139 -                (concat (notmuch-database-path) "/" subdir))))\r
 140 -      \r
 141 -      ;; finally test if fcc points to a valid maildir\r
 142 -      (let ((fcc-header (message-fetch-field "Fcc")))\r
 143 -       (unless (notmuch-maildir-fcc-dir-is-maildir-p fcc-header)\r
 144 -         (cond ((not (file-writable-p fcc-header))\r
 145 -                (error (format "No permission to create %s, which does not exist"\r
 146 -                               fcc-header)))\r
 147 -               ((y-or-n-p (format "%s is not a maildir. Create it? "\r
 148 -                                  fcc-header))\r
 149 -                (notmuch-maildir-fcc-create-maildir fcc-header))\r
 150 -               (t\r
 151 -                (error "Message not sent"))))))))\r
 152 - \r
 153 +  (when notmuch-fcc-dirs\r
 154 +    (let* ((from (or (message-fetch-field "From") ""))\r
 155 +          (subdir (notmuch-fcc-determine-folder notmuch-fcc-dirs from)))\r
 156 +\r
 157 +      (when subdir\r
 158 +       (message-add-header\r
 159 +        (concat "Fcc: "\r
 160 +                ;; If the resulting directory is not an absolute path,\r
 161 +                ;; prepend the standard notmuch database path.\r
 162 +                (if (= (elt subdir 0) ?/)\r
 163 +                    subdir\r
 164 +                  (concat (notmuch-database-path) "/" subdir))))\r
 165 +       \r
 166 +       ;; finally test if fcc points to a valid maildir\r
 167 +       (let ((fcc-header (message-fetch-field "Fcc")))\r
 168 +         (unless (notmuch-maildir-fcc-dir-is-maildir-p fcc-header)\r
 169 +           (cond ((not (file-writable-p fcc-header))\r
 170 +                  (error (format "No permission to create %s, which does not exist"\r
 171 +                                 fcc-header)))\r
 172 +                 ((y-or-n-p (format "%s is not a maildir. Create it? "\r
 173 +                                    fcc-header))\r
 174 +                  (notmuch-maildir-fcc-create-maildir fcc-header))\r
 175 +                 (t\r
 176 +                  (error "Message not sent")))))))))\r
 177 +  \r
 178  (defun notmuch-maildir-fcc-host-fixer (hostname)\r
 179    (replace-regexp-in-string "/\\|:"\r
 180                             '(lambda (s)\r
 181 -                               (cond ((string-equal s "/") "\\057")\r
 182 -                                     ((string-equal s ":") "\\072")\r
 183 -                                     (t s)))\r
 184 +                              (cond ((string-equal s "/") "\\057")\r
 185 +                                    ((string-equal s ":") "\\072")\r
 186 +                                    (t s)))\r
 187                             hostname\r
 188                             t\r
 189                             t))\r
 190 -- \r
 191 1.7.2.3\r
 192 \r