c8/907affd6351bfb1357a083c8689c126685182b

   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 716EC4196F2\r
   6         for <notmuch@notmuchmail.org>; Fri,  5 Nov 2010 01:32:39 -0700 (PDT)\r
   7 X-Virus-Scanned: Debian amavisd-new at olra.theworths.org\r
   8 X-Spam-Flag: NO\r
   9 X-Spam-Score: -1.9\r
  10 X-Spam-Level: \r
  11 X-Spam-Status: No, score=-1.9 tagged_above=-999 required=5\r
  12         tests=[BAYES_00=-1.9, RCVD_IN_DNSWL_NONE=-0.0001] autolearn=ham\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 Z3W8vsUWmEAA for <notmuch@notmuchmail.org>;\r
  16         Fri,  5 Nov 2010 01:32:28 -0700 (PDT)\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 83C9C4196F0\r
  20         for <notmuch@notmuchmail.org>; Fri,  5 Nov 2010 01:32:28 -0700 (PDT)\r
  21 Received: by wyb40 with SMTP id 40so2978315wyb.26\r
  22         for <notmuch@notmuchmail.org>; Fri, 05 Nov 2010 01:32:27 -0700 (PDT)\r
  23 Received: by 10.227.132.129 with SMTP id b1mr1715816wbt.123.1288945946879;\r
  24         Fri, 05 Nov 2010 01:32:26 -0700 (PDT)\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 f14sm807374wbe.8.2010.11.05.01.32.24\r
  28         (version=TLSv1/SSLv3 cipher=RC4-MD5);\r
  29         Fri, 05 Nov 2010 01:32:25 -0700 (PDT)\r
  30 Received: by ut.hh.sledj.net (Postfix, from userid 1000)\r
  31         id 303AF59405B; Fri,  5 Nov 2010 08:31:55 +0000 (GMT)\r
  32 From: David Edmondson <dme@dme.org>\r
  33 To: notmuch@notmuchmail.org\r
  34 Subject: [PATCH] emacs: Improve the definition and use of `notmuch-fcc-dirs'.\r
  35 Date: Fri,  5 Nov 2010 08:31:45 +0000\r
  36 Message-Id: <1288945905-28354-1-git-send-email-dme@dme.org>\r
  37 X-Mailer: git-send-email 1.7.2.3\r
  38 In-Reply-To: <1288905241-31894-1-git-send-email-dme@dme.org>\r
  39 References: <1288905241-31894-1-git-send-email-dme@dme.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: Fri, 05 Nov 2010 08:32:39 -0000\r
  53 \r
  54 Re-work the declaration and definition of `notmuch-fcc-dirs'. The\r
  55 variable now allows three types of values:\r
  56 \r
  57 - nil: no Fcc header is added,\r
  58 \r
  59 - a string: the value of `notmuch-fcc-dirs' is the name of the\r
  60   folder to use,\r
  61 \r
  62 - a list: the folder is chosen based on the From address of the\r
  63   current message using a list of regular expressions and\r
  64   corresponding folders:\r
  65 \r
  66      ((\"Sebastian@SSpaeth.de\" . \"privat\")\r
  67       (\"spaetz@sspaeth.de\" . \"OUTBOX.OSS\")\r
  68       (\".*\" . \"defaultinbox\"))\r
  69 \r
  70   If none of the regular expressions match the From address, no\r
  71   Fcc header will be added.\r
  72 ---\r
  73 \r
  74 Fix the detection of old style settings.\r
  75 \r
  76  emacs/notmuch-maildir-fcc.el |  138 ++++++++++++++++++++++++------------------\r
  77  1 files changed, 79 insertions(+), 59 deletions(-)\r
  78 \r
  79 diff --git a/emacs/notmuch-maildir-fcc.el b/emacs/notmuch-maildir-fcc.el\r
  80 index 693d8d4..8a93d24 100644\r
  81 --- a/emacs/notmuch-maildir-fcc.el\r
  82 +++ b/emacs/notmuch-maildir-fcc.el\r
  83 @@ -16,6 +16,7 @@\r
  84  ;; To use this as the fcc handler for message-mode,\r
  85  ;; customize the notmuch-fcc-dirs variable\r
  86  \r
  87 +(require 'cl-seq)\r
  88  (require 'message)\r
  89  \r
  90  (require 'notmuch-lib)\r
  91 @@ -23,41 +24,40 @@\r
  92  (defvar notmuch-maildir-fcc-count 0)\r
  93  \r
  94  (defcustom notmuch-fcc-dirs "sent"\r
  95 - "Determines the maildir directory to save outgoing mails in.\r
  96 + "Determines the maildir directory in which to save outgoing mail.\r
  97  \r
  98 - If set to non-nil, this will cause message mode to file your\r
  99 - mail in the specified directory (fcc).\r
 100 +Three types of values are permitted:\r
 101  \r
 102 - It is either a string if you only need one fcc directory or a\r
 103 - list if they depend on your From address (see example).\r
 104 +- nil: no Fcc header is added,\r
 105  \r
 106 - In the former case it is a string such as \"INBOX.Sent\".\r
 107 +- a string: the value of `notmuch-fcc-dirs' is the name of the\r
 108 +  folder to use,\r
 109  \r
 110 - In the fancy setup, where you want different outboxes depending\r
 111 - on your From address, you supply a list like this:\r
 112 +- a list: the folder is chosen based on the From address of the\r
 113 +  current message using a list of regular expressions and\r
 114 +  corresponding folders:\r
 115  \r
 116 -     ((\"defaultinbox\")\r
 117 -      (\"Sebastian Spaeth <Sebastian@SSpaeth.de>\" . \"privat\")\r
 118 -      (\"Sebastian Spaeth <spaetz@sspaeth.de>\" . \"OUTBOX.OSS\")\r
 119 -     )\r
 120 +     ((\"Sebastian@SSpaeth.de\" . \"privat\")\r
 121 +      (\"spaetz@sspaeth.de\" . \"OUTBOX.OSS\")\r
 122 +      (\".*\" . \"defaultinbox\"))\r
 123  \r
 124 - The outbox that matches a key (case insensitive) will be\r
 125 - used. The first entry is used as a default fallback when nothing\r
 126 - else matches.\r
 127 +  If none of the regular expressions match the From address, no\r
 128 +  Fcc header will be added.\r
 129  \r
 130 - In all cases, a relative FCC directory will be understood to\r
 131 - specify a directory within the notmuch mail store, (as set by\r
 132 - the database.path option in the notmuch configuration file).\r
 133 +In all cases, a relative FCC directory will be understood to\r
 134 +specify a directory within the notmuch mail store, (as set by\r
 135 +the database.path option in the notmuch configuration file).\r
 136  \r
 137 - You will be prompted to create the directory if it does not exist yet when \r
 138 - sending a mail.\r
 139 -\r
 140 - This function will not modify the headers if there is a FCC\r
 141 - header, but will check that the target directory exists."\r
 142 +You will be prompted to create the directory if it does not exist\r
 143 +yet when sending a mail."\r
 144  \r
 145   :require 'notmuch-fcc-initialization\r
 146   :group 'notmuch\r
 147 -)\r
 148 + :type '(choice\r
 149 +        (const :tag "No FCC header" nil)\r
 150 +        (string :tag "A single folder")\r
 151 +        (repeat :tag "A folder based on the From header"\r
 152 +                (cons regexp (string :tag "Folder")))))\r
 153  \r
 154  (defun notmuch-fcc-initialization ()\r
 155    "If notmuch-fcc-directories is set,\r
 156 @@ -67,44 +67,64 @@\r
 157      (setq message-fcc-handler-function\r
 158            '(lambda (destdir)\r
 159               (notmuch-maildir-fcc-write-buffer-to-maildir destdir t)))\r
 160 -    ;;add a hook to actually insert the Fcc header when sending\r
 161 +    ;; add a hook to actually insert the Fcc header when sending\r
 162      (add-hook 'message-header-setup-hook 'notmuch-fcc-header-setup))\r
 163  \r
 164  (defun notmuch-fcc-header-setup ()\r
 165 -  "Adds an appropriate fcc header to the current mail buffer\r
 166 -\r
 167 -   Can be added to message-send-hook and will set the FCC header\r
 168 -   based on the values of notmuch-fcc-directories (see the\r
 169 -   variable customization there for examples). It uses the first\r
 170 -   entry as default fallback if no From address matches."\r
 171 -  ;; only do something if notmuch-fcc-dirs is set\r
 172 -  (when notmuch-fcc-dirs\r
 173 -    (let (subdir)\r
 174 -      (if (stringp notmuch-fcc-dirs)\r
 175 -          ;; notmuch-fcc-dirs is a string, just use it as subdir\r
 176 -          (setq subdir notmuch-fcc-dirs)\r
 177 -        ;; else: it's a list of alists (("sent") ("name1" . "sent1"))\r
 178 -        (setq subdir (cdr (assoc-string (message-fetch-field "from") notmuch-fcc-dirs t)))\r
 179 -         ;; if we found no hit, use the first entry as default fallback\r
 180 -         (unless subdir (setq subdir (car (car notmuch-fcc-dirs)))))\r
 181 -\r
 182 -  ;; if there is no fcc header yet, add ours\r
 183 -  (unless (message-fetch-field "fcc")\r
 184 -    (message-add-header (concat "Fcc: "\r
 185 -                               (if (= (elt subdir 0) ?/)\r
 186 -                                   subdir\r
 187 -                                 (concat (notmuch-database-path) "/" subdir)))))\r
 188 -\r
 189 -  ;; finally test if fcc points to a valid maildir\r
 190 -  (let ((fcc-header (message-fetch-field "fcc")))\r
 191 -    (unless (notmuch-maildir-fcc-dir-is-maildir-p fcc-header)\r
 192 -      (cond ((not (file-writable-p fcc-header))\r
 193 -             (error (format "%s is not a maildir, but you don't have permission to create one." fcc-header)))\r
 194 -            ((y-or-n-p (format "%s is not a maildir. Create it? "\r
 195 -                               fcc-header))\r
 196 -             (notmuch-maildir-fcc-create-maildir fcc-header))\r
 197 -            (t\r
 198 -             (error "Not sending message."))))))))\r
 199 +  "Add an Fcc header to the current message buffer.\r
 200 +\r
 201 +Can be added to `message-send-hook' and will set the Fcc header\r
 202 +based on the values of `notmuch-fcc-dirs'. An existing Fcc header\r
 203 +will NOT be removed or replaced."\r
 204 +\r
 205 +  (let ((subdir\r
 206 +        (cond\r
 207 +         ((or (not notmuch-fcc-dirs)\r
 208 +              (message-fetch-field "Fcc"))\r
 209 +          ;; Nothing set or an existing header.\r
 210 +          nil)\r
 211 +\r
 212 +         ((stringp notmuch-fcc-dirs)\r
 213 +          notmuch-fcc-dirs)\r
 214 +\r
 215 +         ((and (listp notmuch-fcc-dirs)\r
 216 +               (= 1 (length (car notmuch-fcc-dirs))))\r
 217 +          ;; Old style - no longer works.\r
 218 +          (error "Invalid `notmuch-fcc-dirs' setting (old style)"))\r
 219 +\r
 220 +         ((listp notmuch-fcc-dirs)\r
 221 +          (let* ((from (message-fetch-field "From"))\r
 222 +                 (match\r
 223 +                  (assoc-if '(lambda (re) (string-match-p re from))\r
 224 +                            notmuch-fcc-dirs)))\r
 225 +            (if match\r
 226 +                (cdr match)\r
 227 +              (message "No Fcc header added.")\r
 228 +              nil)))\r
 229 +\r
 230 +         (t\r
 231 +          (error "Invalid `notmuch-fcc-dirs' setting (neither string nor list)")))))\r
 232 +\r
 233 +    (when subdir\r
 234 +      (message-add-header\r
 235 +       (concat "Fcc: "\r
 236 +              ;; If the resulting directory is not an absolute path,\r
 237 +              ;; prepend the standard notmuch database path.\r
 238 +              (if (= (elt subdir 0) ?/)\r
 239 +                  subdir\r
 240 +                (concat (notmuch-database-path) "/" subdir))))\r
 241 +      \r
 242 +      ;; finally test if fcc points to a valid maildir\r
 243 +      (let ((fcc-header (message-fetch-field "Fcc")))\r
 244 +       (unless (notmuch-maildir-fcc-dir-is-maildir-p fcc-header)\r
 245 +         (cond ((not (file-writable-p fcc-header))\r
 246 +                (error (format "No permission to create %s, which does not exist"\r
 247 +                               fcc-header)))\r
 248 +               ((y-or-n-p (format "%s is not a maildir. Create it? "\r
 249 +                                  fcc-header))\r
 250 +                (notmuch-maildir-fcc-create-maildir fcc-header))\r
 251 +               (t\r
 252 +                (error "Message not sent"))))))))\r
 253   \r
 254  (defun notmuch-maildir-fcc-host-fixer (hostname)\r
 255    (replace-regexp-in-string "/\\|:"\r
 256 -- \r
 257 1.7.2.3\r
 258 \r