8f/77ef32930bd6fd51335b70e97fdb471b3f17ae

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