1;;; mh-identity.el --- multiple identify support for MH-E 2 3;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. 4 5;; Author: Peter S. Galbraith <psg@debian.org> 6;; Maintainer: Bill Wohler <wohler@newt.com> 7;; Keywords: mail 8;; See: mh-e.el 9 10;; This file is part of GNU Emacs. 11 12;; GNU Emacs is free software; you can redistribute it and/or modify 13;; it under the terms of the GNU General Public License as published by 14;; the Free Software Foundation; either version 2, or (at your option) 15;; any later version. 16 17;; GNU Emacs is distributed in the hope that it will be useful, 18;; but WITHOUT ANY WARRANTY; without even the implied warranty of 19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 20;; GNU General Public License for more details. 21 22;; You should have received a copy of the GNU General Public License 23;; along with GNU Emacs; see the file COPYING. If not, write to the 24;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 25;; Boston, MA 02110-1301, USA. 26 27;;; Commentary: 28 29;; Multiple identity support for MH-E. 30 31;; Used to easily set different fields such as From and Organization, 32;; as well as different signature files. 33 34;; Customize the variable `mh-identity-list' and see the Identity menu 35;; in MH-Letter mode. The command `mh-insert-identity' can be used 36;; to manually insert an identity. 37 38;;; Change Log: 39 40;;; Code: 41 42(require 'mh-e) 43 44(autoload 'mml-insert-tag "mml") 45 46(defvar mh-identity-pgg-default-user-id nil 47 "Holds the GPG key ID to be used by pgg.el. 48This is normally set as part of an Identity in 49`mh-identity-list'.") 50(make-variable-buffer-local 'mh-identity-pgg-default-user-id) 51 52(defvar mh-identity-menu nil 53 "The Identity menu.") 54 55(defalias 'mh-identity-make-menu-no-autoload 'mh-identity-make-menu) 56 57;;;###mh-autoload 58(defun mh-identity-make-menu () 59 "Build the Identity menu. 60This should be called any time `mh-identity-list' or 61`mh-auto-fields-list' change. 62See `mh-identity-add-menu'." 63 (easy-menu-define mh-identity-menu mh-letter-mode-map 64 "MH-E identity menu" 65 (append 66 '("Identity") 67 ;; Dynamically render :type corresponding to `mh-identity-list' 68 ;; e.g.: 69 ;; ["Home" (mh-insert-identity "Home") 70 ;; :style radio :active (not (equal mh-identity-local "Home")) 71 ;; :selected (equal mh-identity-local "Home")] 72 '(["Insert Auto Fields" 73 (mh-insert-auto-fields) mh-auto-fields-list] 74 "--") 75 76 (mapcar (function 77 (lambda (arg) 78 `[,arg (mh-insert-identity ,arg) :style radio 79 :selected (equal mh-identity-local ,arg)])) 80 (mapcar 'car mh-identity-list)) 81 '(["None" 82 (mh-insert-identity "None") :style radio 83 :selected (not mh-identity-local)] 84 "--" 85 ["Set Default for Session" 86 (setq mh-identity-default mh-identity-local) t] 87 ["Save as Default" 88 (customize-save-variable 'mh-identity-default mh-identity-local) t] 89 ["Customize Identities" (customize-variable 'mh-identity-list) t] 90 )))) 91 92;;;###mh-autoload 93(defun mh-identity-add-menu () 94 "Add the current Identity menu. 95See `mh-identity-make-menu'." 96 (if mh-identity-menu 97 (easy-menu-add mh-identity-menu))) 98 99(defvar mh-identity-local nil 100 "Buffer-local variable that holds the identity currently in use.") 101(make-variable-buffer-local 'mh-identity-local) 102 103(defun mh-header-field-delete (field value-only) 104 "Delete header FIELD, or only its value if VALUE-ONLY is t. 105Return t if anything is deleted." 106 (let ((field-colon (if (string-match "^.*:$" field) 107 field 108 (concat field ":")))) 109 (when (mh-goto-header-field field-colon) 110 (if (not value-only) 111 (beginning-of-line) 112 (forward-char)) 113 (delete-region (point) 114 (progn (mh-header-field-end) 115 (if (not value-only) (forward-char 1)) 116 (point))) 117 t))) 118 119(defvar mh-identity-signature-start nil 120 "Marker for the beginning of a signature inserted by `mh-insert-identity'.") 121(defvar mh-identity-signature-end nil 122 "Marker for the end of a signature inserted by `mh-insert-identity'.") 123 124(defun mh-identity-field-handler (field) 125 "Return the handler for header FIELD or nil if none set. 126The field name is downcased. If the FIELD begins with the 127character \":\", then it must have a special handler defined in 128`mh-identity-handlers', else return an error since it is not a 129valid header field." 130 (or (cdr (mh-assoc-string field mh-identity-handlers t)) 131 (and (eq (aref field 0) ?:) 132 (error "Field %s not found in `mh-identity-handlers'" field)) 133 (cdr (assoc ":default" mh-identity-handlers)) 134 'mh-identity-handler-default)) 135 136;;;###mh-autoload 137(defun mh-insert-identity (identity &optional maybe-insert) 138 "Insert fields specified by given IDENTITY. 139 140In a program, do not insert fields if MAYBE-INSERT is non-nil, 141`mh-identity-default' is non-nil, and fields have already been 142inserted. 143 144See `mh-identity-list'." 145 (interactive 146 (list (completing-read 147 "Identity: " 148 (if mh-identity-local 149 (cons '("None") 150 (mapcar 'list (mapcar 'car mh-identity-list))) 151 (mapcar 'list (mapcar 'car mh-identity-list))) 152 nil t) 153 nil)) 154 155 (when (or (not maybe-insert) 156 (and (boundp 'mh-identity-default) 157 mh-identity-default 158 (not mh-identity-local))) 159 (save-excursion 160 ;;First remove old settings, if any. 161 (when mh-identity-local 162 (let ((pers-list (cadr (assoc mh-identity-local mh-identity-list)))) 163 (while pers-list 164 (let* ((field (caar pers-list)) 165 (handler (mh-identity-field-handler field))) 166 (funcall handler field 'remove)) 167 (setq pers-list (cdr pers-list))))) 168 ;; Then insert the replacement 169 (when (not (equal "None" identity)) 170 (let ((pers-list (cadr (assoc identity mh-identity-list)))) 171 (while pers-list 172 (let* ((field (caar pers-list)) 173 (value (cdar pers-list)) 174 (handler (mh-identity-field-handler field))) 175 (funcall handler field 'add value)) 176 (setq pers-list (cdr pers-list)))))) 177 ;; Remember what is in use in this buffer 178 (if (equal "None" identity) 179 (setq mh-identity-local nil) 180 (setq mh-identity-local identity)))) 181 182;;;###mh-autoload 183(defun mh-identity-handler-gpg-identity (field action &optional value) 184 "Process header FIELD \":pgg-default-user-id\". 185The ACTION is one of 'remove or 'add. If 'add, the VALUE is added. 186The buffer-local variable `mh-identity-pgg-default-user-id' is set to 187VALUE when action 'add is selected." 188 (cond 189 ((or (equal action 'remove) 190 (not value) 191 (string= value "")) 192 (setq mh-identity-pgg-default-user-id nil)) 193 ((equal action 'add) 194 (setq mh-identity-pgg-default-user-id value)))) 195 196;;;###mh-autoload 197(defun mh-identity-handler-signature (field action &optional value) 198 "Process header FIELD \":signature\". 199The ACTION is one of 'remove or 'add. If 'add, the VALUE is 200added." 201 (cond 202 ((equal action 'remove) 203 (when (and (markerp mh-identity-signature-start) 204 (markerp mh-identity-signature-end)) 205 (delete-region mh-identity-signature-start 206 mh-identity-signature-end))) 207 (t 208 ;; Insert "signature". Nil value means to use `mh-signature-file-name'. 209 (when (not (mh-signature-separator-p)) ;...unless already present 210 (goto-char (point-max)) 211 (save-restriction 212 (narrow-to-region (point) (point)) 213 (if (null value) 214 (mh-insert-signature) 215 (mh-insert-signature value)) 216 (set (make-local-variable 'mh-identity-signature-start) 217 (point-min-marker)) 218 (set-marker-insertion-type mh-identity-signature-start t) 219 (set (make-local-variable 'mh-identity-signature-end) 220 (point-max-marker))))))) 221 222(defvar mh-identity-attribution-verb-start nil 223 "Marker for the beginning of the attribution verb.") 224(defvar mh-identity-attribution-verb-end nil 225 "Marker for the end of the attribution verb.") 226 227;;;###mh-autoload 228(defun mh-identity-handler-attribution-verb (field action &optional value) 229 "Process header FIELD \":attribution-verb\". 230The ACTION is one of 'remove or 'add. If 'add, the VALUE is 231added." 232 (when (and (markerp mh-identity-attribution-verb-start) 233 (markerp mh-identity-attribution-verb-end)) 234 (delete-region mh-identity-attribution-verb-start 235 mh-identity-attribution-verb-end) 236 (goto-char mh-identity-attribution-verb-start) 237 (cond 238 ((equal action 'remove) ; Replace with default 239 (mh-identity-insert-attribution-verb nil)) 240 (t ; Insert attribution verb. 241 (mh-identity-insert-attribution-verb value))))) 242 243;;;###mh-autoload 244(defun mh-identity-insert-attribution-verb (value) 245 "Insert VALUE as attribution verb, setting up delimiting markers. 246If VALUE is nil, use `mh-extract-from-attribution-verb'." 247 (save-restriction 248 (narrow-to-region (point) (point)) 249 (if (null value) 250 (insert mh-extract-from-attribution-verb) 251 (insert value)) 252 (set (make-local-variable 'mh-identity-attribution-verb-start) 253 (point-min-marker)) 254 (set-marker-insertion-type mh-identity-attribution-verb-start t) 255 (set (make-local-variable 'mh-identity-attribution-verb-end) 256 (point-max-marker)))) 257 258(defun mh-identity-handler-default (field action top &optional value) 259 "Process header FIELD. 260The ACTION is one of 'remove or 'add. If TOP is non-nil, add the 261field and its VALUE at the top of the header, else add it at the 262bottom of the header. If action is 'add, the VALUE is added." 263 (let ((field-colon (if (string-match "^.*:$" field) 264 field 265 (concat field ":")))) 266 (cond 267 ((equal action 'remove) 268 (mh-header-field-delete field-colon nil)) 269 (t 270 (cond 271 ;; No value, remove field 272 ((or (not value) 273 (string= value "")) 274 (mh-header-field-delete field-colon nil)) 275 ;; Existing field, replace 276 ((mh-header-field-delete field-colon t) 277 (insert value)) 278 ;; Other field, add at end or top 279 (t 280 (goto-char (point-min)) 281 (if (not top) 282 (mh-goto-header-end 0)) 283 (insert field-colon " " value "\n"))))))) 284 285;;;###mh-autoload 286(defun mh-identity-handler-top (field action &optional value) 287 "Process header FIELD. 288The ACTION is one of 'remove or 'add. If 'add, the VALUE is 289added. If the field wasn't present, it is added to the top of the 290header." 291 (mh-identity-handler-default field action t value)) 292 293;;;###mh-autoload 294(defun mh-identity-handler-bottom (field action &optional value) 295 "Process header FIELD. 296The ACTION is one of 'remove or 'add. If 'add, the VALUE is 297added. If the field wasn't present, it is added to the bottom of 298the header." 299 (mh-identity-handler-default field action nil value)) 300 301(provide 'mh-identity) 302 303;; Local Variables: 304;; indent-tabs-mode: nil 305;; sentence-end-double-space: nil 306;; End: 307 308;; arch-tag: 07d66ef6-8726-4ac6-9ecf-e566cd5bfb45 309;;; mh-identity.el ends here 310