/[emacs]/emacs/lisp/mh-e/mh-identity.el
ViewVC logotype

Diff of /emacs/lisp/mh-e/mh-identity.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.3.4.3 by miles, Sat Jul 17 02:51:49 2004 UTC revision 1.3.4.4 by miles, Sat Sep 4 09:22:56 2004 UTC
# Line 39  Line 39 
39    
40  ;;; Code:  ;;; Code:
41    
42    (eval-when-compile (require 'mh-acros))
 (require 'mh-utils)  
43  (mh-require-cl)  (mh-require-cl)
44    (require 'mh-comp)
 (eval-when (compile load eval)  
   (defvar mh-comp-loaded nil)  
   (unless mh-comp-loaded  
     (setq mh-comp-loaded t)  
     (require 'mh-comp)))                   ;Since we do this on sending  
45    
46  (autoload 'mml-insert-tag "mml")  (autoload 'mml-insert-tag "mml")
47    
48    (defvar mh-identity-pgg-default-user-id nil
49      "Holds the GPG key ID to be used by pgg.el.
50    This is normally set as part of an Identity in `mh-identity-list'.")
51    (make-variable-buffer-local 'mh-identity-pgg-default-user-id)
52    
53  ;;;###mh-autoload  ;;;###mh-autoload
54  (defun mh-identity-make-menu ()  (defun mh-identity-make-menu ()
55    "Build (or rebuild) the Identity menu (e.g. after the list is modified)."    "Build the Identity menu.
56    (when (and mh-identity-list (boundp 'mh-letter-mode-map))  This should be called any time `mh-identity-list' or `mh-auto-fields-list'
57      (easy-menu-define mh-identity-menu mh-letter-mode-map  change."
58        "mh-e identity menu"    (easy-menu-define mh-identity-menu mh-letter-mode-map
59        (append      "MH-E identity menu"
60         '("Identity")      (append
61         ;; Dynamically render :type corresponding to `mh-identity-list'       '("Identity")
62         ;; e.g.:       ;; Dynamically render :type corresponding to `mh-identity-list'
63         ;;  ["home" (mh-insert-identity "home")       ;; e.g.:
64         ;;   :style radio :active (not (equal mh-identity-local "home"))       ;;  ["Home" (mh-insert-identity "Home")
65         ;;   :selected (equal mh-identity-local "home")]       ;;   :style radio :active (not (equal mh-identity-local "Home"))
66         '(["Insert Auto Fields" (mh-insert-auto-fields) mh-auto-fields-list]       ;;   :selected (equal mh-identity-local "Home")]
67           "--")       '(["Insert Auto Fields"
68         (mapcar (function          (mh-insert-auto-fields) mh-auto-fields-list]
69                  (lambda (arg)         "--")
70                    `[,arg  (mh-insert-identity ,arg) :style radio  
71                            :active (not (equal mh-identity-local ,arg))       (mapcar (function
72                            :selected (equal mh-identity-local ,arg)]))                (lambda (arg)
73                 (mapcar 'car mh-identity-list))                  `[,arg  (mh-insert-identity ,arg) :style radio
74         '("--"                          :selected (equal mh-identity-local ,arg)]))
75           ["none" (mh-insert-identity "none") mh-identity-local]               (mapcar 'car mh-identity-list))
76           ["Set Default for Session"       '(["None"
77            (setq mh-identity-default mh-identity-local) t]          (mh-insert-identity "None") :style radio
78           ["Save as Default"          :selected (not mh-identity-local)]
79            (customize-save-variable         "--"
80             'mh-identity-default mh-identity-local) t]         ["Set Default for Session"
81           )))))          (setq mh-identity-default mh-identity-local) t]
82           ["Save as Default"
83            (customize-save-variable 'mh-identity-default mh-identity-local) t]
84           ["Customize Identities" (customize-variable 'mh-identity-list) t]
85           ))))
86    
87  ;;;###mh-autoload  ;;;###mh-autoload
88  (defun mh-identity-list-set (symbol value)  (defun mh-identity-list-set (symbol value)
# Line 97  customization).  This is called after 'c Line 100  customization).  This is called after 'c
100  (defun mh-header-field-delete (field value-only)  (defun mh-header-field-delete (field value-only)
101    "Delete FIELD in the mail header, or only its value if VALUE-ONLY is t.    "Delete FIELD in the mail header, or only its value if VALUE-ONLY is t.
102  Return t if anything is deleted."  Return t if anything is deleted."
103    (when (mh-goto-header-field field)    (let ((field-colon (if (string-match "^.*:$" field)
104      (if (not value-only)                           field
105          (beginning-of-line)                         (concat field ":"))))
106        (forward-char))      (when (mh-goto-header-field field-colon)
107      (delete-region (point)        (if (not value-only)
108                     (progn (mh-header-field-end)            (beginning-of-line)
109                            (if (not value-only) (forward-char 1))          (forward-char))
110                            (point)))        (delete-region (point)
111      t))                       (progn (mh-header-field-end)
112                                (if (not value-only) (forward-char 1))
113                                (point)))
114          t)))
115    
116  (defvar mh-identity-signature-start nil  (defvar mh-identity-signature-start nil
117    "Marker for the beginning of a signature inserted by `mh-insert-identity'.")    "Marker for the beginning of a signature inserted by `mh-insert-identity'.")
118  (defvar mh-identity-signature-end nil  (defvar mh-identity-signature-end nil
119    "Marker for the end of a signature inserted by `mh-insert-identity'.")    "Marker for the end of a signature inserted by `mh-insert-identity'.")
120    
121    (defun mh-identity-field-handler (field)
122      "Return the handler for a FIELD or nil if none set.
123    The field name is downcased. If the FIELD begins with the character
124    `:', then it must have a special handler defined in
125    `mh-identity-handlers', else return an error since it is not a legal
126    message header."
127      (or (cdr (assoc (downcase field) mh-identity-handlers))
128          (and (eq (aref field 0) ?:)
129               (error (format "Field %s - unknown mh-identity-handler" field)))
130          (cdr (assoc "default" mh-identity-handlers))
131          'mh-identity-handler-default))
132    
133  ;;;###mh-autoload  ;;;###mh-autoload
134  (defun mh-insert-identity (identity)  (defun mh-insert-identity (identity)
135    "Insert proper fields for given IDENTITY.    "Insert proper fields for given IDENTITY.
# Line 120  Edit the `mh-identity-list' variable to Line 138  Edit the `mh-identity-list' variable to
138     (list (completing-read     (list (completing-read
139            "Identity: "            "Identity: "
140            (if mh-identity-local            (if mh-identity-local
141                (cons '("none")                (cons '("None")
142                      (mapcar 'list (mapcar 'car mh-identity-list)))                      (mapcar 'list (mapcar 'car mh-identity-list)))
143              (mapcar 'list (mapcar 'car mh-identity-list)))              (mapcar 'list (mapcar 'car mh-identity-list)))
144            nil t)))            nil t)))
# Line 129  Edit the `mh-identity-list' variable to Line 147  Edit the `mh-identity-list' variable to
147      (when mh-identity-local      (when mh-identity-local
148        (let ((pers-list (cadr (assoc mh-identity-local mh-identity-list))))        (let ((pers-list (cadr (assoc mh-identity-local mh-identity-list))))
149          (while pers-list          (while pers-list
150            (let ((field (concat (caar pers-list) ":")))            (let* ((field (caar pers-list))
151              (cond                   (handler (mh-identity-field-handler field)))
152               ((string-equal "signature:" field)              (funcall handler field 'remove))
               (when (and (boundp 'mh-identity-signature-start)  
                          (markerp mh-identity-signature-start))  
                 (goto-char mh-identity-signature-start)  
                 (forward-char -1)  
                 (delete-region (point) mh-identity-signature-end)))  
              ((mh-header-field-delete field nil))))  
153            (setq pers-list (cdr pers-list)))))            (setq pers-list (cdr pers-list)))))
154      ;; Then insert the replacement      ;; Then insert the replacement
155      (when (not (equal "none" identity))      (when (not (equal "None" identity))
156        (let ((pers-list (cadr (assoc identity mh-identity-list))))        (let ((pers-list (cadr (assoc identity mh-identity-list))))
157          (while pers-list          (while pers-list
158            (let ((field (concat (caar pers-list) ":"))            (let* ((field (caar pers-list))
159                  (value (cdar pers-list)))                   (value (cdar pers-list))
160              (cond                   (handler (mh-identity-field-handler field)))
161               ;; No value, remove field              (funcall handler field 'add value))
              ((or (not value)  
                   (string= value ""))  
               (mh-header-field-delete field nil))  
              ;; Existing field, replace  
              ((mh-header-field-delete field t)  
               (insert value))  
              ;; Handle "signature" special case. Insert file or call function.  
              ((and (string-equal "signature:" field)  
                    (or (and (stringp value)  
                             (file-readable-p value))  
                        (fboundp value)))  
               (goto-char (point-max))  
               (if (not (looking-at "^$"))  
                   (insert "\n"))  
               (insert "\n")  
               (save-restriction  
                 (narrow-to-region (point) (point))  
                 (set (make-local-variable 'mh-identity-signature-start)  
                      (make-marker))  
                 (set-marker mh-identity-signature-start (point))  
                 (cond  
                  ;; If MIME composition done, insert signature at the end as  
                  ;; an inline MIME part.  
                  ((mh-mhn-directive-present-p)  
                   (insert "#\n" "Content-Description: Signature\n"))  
                  ((mh-mml-directive-present-p)  
                   (mml-insert-tag 'part 'type "text/plain"  
                                   'disposition "inline"  
                                   'description "Signature")))  
                 (if (stringp value)  
                     (insert-file-contents value)  
                   (funcall value))  
                 (goto-char (point-min))  
                 (when (not (re-search-forward "^--" nil t))  
                   (cond ((mh-mhn-directive-present-p)  
                          (forward-line 2))  
                         ((mh-mml-directive-present-p)  
                          (forward-line 1)))  
                   (insert "-- \n"))  
                 (set (make-local-variable 'mh-identity-signature-end)  
                      (make-marker))  
                 (set-marker mh-identity-signature-end (point-max))))  
              ;; Handle "From" field differently, adding it at the beginning.  
              ((string-equal "From:" field)  
               (goto-char (point-min))  
               (insert "From: " value "\n"))  
              ;; Skip empty signature (Can't remove what we don't know)  
              ((string-equal "signature:" field))  
              ;; Other field, add at end  
              (t                         ;Otherwise, add the end.  
               (goto-char (point-min))  
               (mh-goto-header-end 0)  
               (mh-insert-fields field value))))  
162            (setq pers-list (cdr pers-list))))))            (setq pers-list (cdr pers-list))))))
163    ;; Remember what is in use in this buffer    ;; Remember what is in use in this buffer
164    (if (equal "none" identity)    (if (equal "None" identity)
165        (setq mh-identity-local nil)        (setq mh-identity-local nil)
166      (setq mh-identity-local identity)))      (setq mh-identity-local identity)))
167    
168    ;;;###mh-autoload
169    (defun mh-identity-handler-gpg-identity (field action &optional value)
170      "For FIELD \"pgg-default-user-id\", process for ACTION 'remove or 'add.
171    The buffer-local variable `mh-identity-pgg-default-user-id' is set to VALUE
172    when action 'add is selected."
173      (cond
174       ((or (equal action 'remove)
175            (not value)
176            (string= value ""))
177        (setq mh-identity-pgg-default-user-id nil))
178       ((equal action 'add)
179        (setq mh-identity-pgg-default-user-id value))))
180    
181    ;;;###mh-autoload
182    (defun mh-identity-handler-signature (field action &optional value)
183      "For FIELD \"signature\", process headers for ACTION 'remove or 'add.
184    The VALUE is added."
185      (cond
186       ((equal action 'remove)
187        (when (and (markerp mh-identity-signature-start)
188                   (markerp mh-identity-signature-end))
189          (delete-region mh-identity-signature-start
190                         mh-identity-signature-end)))
191       (t
192        ;; Insert "signature". Nil value means to use `mh-signature-file-name'.
193        (when (not (mh-signature-separator-p)) ;...unless already present
194          (goto-char (point-max))
195          (save-restriction
196            (narrow-to-region (point) (point))
197            (if (null value)
198                (mh-insert-signature)
199              (mh-insert-signature value))
200            (set (make-local-variable 'mh-identity-signature-start)
201                 (point-min-marker))
202            (set-marker-insertion-type mh-identity-signature-start t)
203            (set (make-local-variable 'mh-identity-signature-end)
204                 (point-max-marker)))))))
205    
206    (defvar mh-identity-attribution-verb-start nil
207      "Marker for the beginning of the attribution verb.")
208    (defvar mh-identity-attribution-verb-end nil
209      "Marker for the end of the attribution verb.")
210    
211    ;;;###mh-autoload
212    (defun mh-identity-handler-attribution-verb (field action &optional value)
213      "For FIELD \"attribution_verb\", process headers for ACTION 'remove or 'add.
214    The VALUE is added."
215      (when (and (markerp mh-identity-attribution-verb-start)
216                 (markerp mh-identity-attribution-verb-end))
217        (delete-region mh-identity-attribution-verb-start
218                       mh-identity-attribution-verb-end)
219        (goto-char mh-identity-attribution-verb-start)
220        (cond
221         ((equal action 'remove)              ; Replace with default
222          (mh-identity-insert-attribution-verb nil))
223         (t                                   ; Insert attribution verb.
224          (mh-identity-insert-attribution-verb value)))))
225    
226    ;;;###mh-autoload
227    (defun mh-identity-insert-attribution-verb (value)
228      "Insert VALUE as attribution verb, setting up delimiting markers.
229    If VALUE is nil, use `mh-extract-from-attribution-verb'."
230      (save-restriction
231        (narrow-to-region (point) (point))
232        (if (null value)
233            (insert mh-extract-from-attribution-verb)
234          (insert value))
235        (set (make-local-variable 'mh-identity-attribution-verb-start)
236             (point-min-marker))
237        (set-marker-insertion-type mh-identity-attribution-verb-start t)
238        (set (make-local-variable 'mh-identity-attribution-verb-end)
239             (point-max-marker))))
240    
241    (defun mh-identity-handler-default (field action top &optional value)
242      "For FIELD, process mh-identity headers for ACTION 'remove or 'add.
243    if TOP is non-nil, add the field and it's VALUE at the top of the header, else
244    add it at the bottom of the header."
245      (let ((field-colon (if (string-match "^.*:$" field)
246                             field
247                           (concat field ":"))))
248        (cond
249         ((equal action 'remove)
250          (mh-header-field-delete field-colon nil))
251         (t
252          (cond
253           ;; No value, remove field
254           ((or (not value)
255                (string= value ""))
256            (mh-header-field-delete field-colon nil))
257           ;; Existing field, replace
258           ((mh-header-field-delete field-colon t)
259            (insert value))
260           ;; Other field, add at end or top
261           (t
262            (goto-char (point-min))
263            (if (not top)
264                (mh-goto-header-end 0))
265            (insert field-colon " " value "\n")))))))
266    
267    ;;;###mh-autoload
268    (defun mh-identity-handler-top (field action &optional value)
269      "For FIELD, process mh-identity headers for ACTION 'remove or 'add.
270    If the field wasn't present, the VALUE is added at the top of the header."
271      (mh-identity-handler-default field action t value))
272    
273    ;;;###mh-autoload
274    (defun mh-identity-handler-bottom (field action &optional value)
275      "For FIELD, process mh-identity headers for ACTION 'remove or 'add.
276    If the field wasn't present, the VALUE is added at the bottom of the header."
277      (mh-identity-handler-default field action nil value))
278    
279  (provide 'mh-identity)  (provide 'mh-identity)
280    
281  ;;; Local Variables:  ;;; Local Variables:

Legend:
Removed from v.1.3.4.3  
changed lines
  Added in v.1.3.4.4

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26