view lisp/mh-e/mh-identity.el @ 50507:110c0e29159c

Handle multiple desktop files in different dirs. Other cleanups. Command line option --no-desktop introduced. (desktop-read): Record buffers in the desktop file in the same order as that in the buffer list, (desktop-save): Put buffers in the order given in desktop file, regardless of what handlers do. (desktop-file-version): New variable. Version number of desktop file format. (desktop-create-buffer-form): Variable deleted. (desktop-save): New customizable variable. (desktop-kill): Changed to use `desktop-save'. (desktop-file-name-format): New option: format in which desktop file names should be saved. (desktop-file-name): New function to convert a filename to the format specified in `desktop-file-name-format'. (desktop-create-buffer): Parameters renamed to descriptive systematic names. These parameters are visible to handlers. Renames: ver -> desktop-file-version mim -> desktop-buffer-minor-modes pt -> desktop-buffer-point mk -> desktop-buffer-mark ro -> desktop-buffer-read-only locals -> desktop-buffer-locals (desktop-buffer-major-mode, desktop-buffer-file-name) (desktop-buffer-name): Unused customizable variables deleted. (desktop-buffer-misc): Unused variable deleted. (desktop-save, desktop-buffer-dired-misc-data): Use `desktop-file-name'. (desktop-path): New customizable variable. List of directories in which to lookup the desktop file. Replaces hardcoded list. (desktop-globals-to-clear): New variable replaces hardcoded list. (desktop-clear-preserve-buffers-regexp): New customizable variable. (desktop-after-read-hook): New hook run after a desktop is read. (desktop-no-desktop-file-hook): New hook when no desktop file found. (desktop-change-dir): New function. (desktop-save-in-load-dir): New function. Save desktop in directory from witch it was loaded. (desktop-revert): New function. Revert to the last loaded desktop.

;;; mh-identity.el --- Multiple Identify support for MH-E.

;; Copyright (C) 2002 Free Software Foundation, Inc.

;; Author: Peter S. Galbraith <[e-mail]>
;; Maintainer: Bill Wohler <[e-mail]>
;; Keywords: mail
;; See: mh-e.el

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; Multiple identity support for MH-E.
;;
;; Used to easily set different fields such as From and Organization, as
;; well as different signature files.
;;
;; Customize the variable `mh-identity-list' and an Identity menu will
;; appear in mh-letter-mode.  The command 'mh-insert-identity can be used
;; from the command line.

;;; Change Log:

;; $Id: mh-identity.el,v 1.2 2003/02/03 20:55:30 wohler Exp $

;;; Code:


(require 'cl)

(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

(autoload 'mml-insert-tag "mml")

;;;###mh-autoload
(defun mh-identity-make-menu ()
  "Build (or rebuild) the Identity menu (e.g. after the list is modified)."
  (when (and mh-identity-list (boundp 'mh-letter-mode-map))
    (easy-menu-define mh-identity-menu mh-letter-mode-map
      "mh-e identity menu"
      (append
       '("Identity")
       ;; Dynamically render :type corresponding to `mh-identity-list'
       ;; e.g.:
       ;;  ["home" (mh-insert-identity "home")
       ;;   :style radio :active (not (equal mh-identity-local "home"))
       ;;   :selected (equal mh-identity-local "home")]
       (mapcar (function
                (lambda (arg)
                  `[,arg  (mh-insert-identity ,arg) :style radio
                          :active (not (equal mh-identity-local ,arg))
                          :selected (equal mh-identity-local ,arg)]))
               (mapcar 'car mh-identity-list))
       '("--"
         ["none" (mh-insert-identity "none") mh-identity-local]
         ["Set Default for Session"
          (setq mh-identity-default mh-identity-local) t]
         ["Save as Default"
          (customize-save-variable
           'mh-identity-default mh-identity-local) t]
         )))))

;;;###mh-autoload
(defun mh-identity-list-set (symbol value)
  "Update the `mh-identity-list' variable, and rebuild the menu.
Sets the default for SYMBOL (e.g. `mh-identity-list') to VALUE (as set in
customization).  This is called after 'customize is used to alter
`mh-identity-list'."
  (set-default symbol value)
  (mh-identity-make-menu))

(defvar mh-identity-local nil
  "Buffer-local variable holding the identity currently in use.")
(make-variable-buffer-local 'mh-identity-local)

(defun mh-header-field-delete (field value-only)
  "Delete FIELD in the mail header, or only its value if VALUE-ONLY is t.
Return t if anything is deleted."
  (when (mh-goto-header-field field)
    (if (not value-only)
        (beginning-of-line)
      (forward-char))
    (delete-region (point)
                   (progn (mh-header-field-end)
                          (if (not value-only) (forward-char 1))
                          (point)))
    t))

(defvar mh-identity-signature-start nil
  "Marker for the beginning of a signature inserted by `mh-insert-identity'.")
(defvar mh-identity-signature-end nil
  "Marker for the end of a signature inserted by `mh-insert-identity'.")

;;;###mh-autoload
(defun mh-insert-identity (identity)
  "Insert proper fields for given IDENTITY.
Edit the `mh-identity-list' variable to define identity."
  (interactive
   (list (completing-read
          "Identity: "
          (if mh-identity-local
              (cons '("none")
                    (mapcar 'list (mapcar 'car mh-identity-list)))
            (mapcar 'list (mapcar 'car mh-identity-list)))
          nil t)))
  (save-excursion
    ;;First remove old settings, if any.
    (when mh-identity-local
      (let ((pers-list (cadr (assoc mh-identity-local mh-identity-list))))
        (while pers-list
          (let ((field (concat (caar pers-list) ":")))
            (cond
             ((string-equal "signature:" field)
              (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))))
          (setq pers-list (cdr pers-list)))))
    ;; Then insert the replacement
    (when (not (equal "none" identity))
      (let ((pers-list (cadr (assoc identity mh-identity-list))))
        (while pers-list
          (let ((field (concat (caar pers-list) ":"))
                (value (cdar pers-list)))
            (cond
             ;; No value, remove field
             ((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.
                 ((and (boundp 'mh-mhn-compose-insert-flag)
                       mh-mhn-compose-insert-flag)
                  (insert "#\n" "Content-Description: Signature\n"))
                 ((and (boundp 'mh-mml-compose-insert-flag)
                       mh-mml-compose-insert-flag)
                  (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))
                  (if (and (boundp 'mh-mhn-compose-insert-flag)
                           mh-mhn-compose-insert-flag)
                      (forward-line 2))
                  (if (and (boundp 'mh-mml-compose-insert-flag)
                           mh-mml-compose-insert-flag)
                      (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))))
          (setq pers-list (cdr pers-list))))))
  ;; Remember what is in use in this buffer
  (if (equal "none" identity)
      (setq mh-identity-local nil)
    (setq mh-identity-local identity)))

(provide 'mh-identity)

;;; Local Variables:
;;; indent-tabs-mode: nil
;;; sentence-end-double-space: nil
;;; End:

;;; mh-identity.el ends here