home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / gnu / lucid / lemacs-19.6 / lisp / vm / vm-edit.el < prev    next >
Encoding:
Text File  |  1992-06-29  |  8.3 KB  |  222 lines
  1. ;;; Editing VM messages
  2. ;;; Copyright (C) 1990, 1991 Kyle E. Jones
  3. ;;;
  4. ;;; This program is free software; you can redistribute it and/or modify
  5. ;;; it under the terms of the GNU General Public License as published by
  6. ;;; the Free Software Foundation; either version 1, or (at your option)
  7. ;;; any later version.
  8. ;;;
  9. ;;; This program is distributed in the hope that it will be useful,
  10. ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12. ;;; GNU General Public License for more details.
  13. ;;;
  14. ;;; You should have received a copy of the GNU General Public License
  15. ;;; along with this program; if not, write to the Free Software
  16. ;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  17.  
  18. (defun vm-edit-message (&optional prefix-argument)
  19.   "Edit the current message.  Prefix arg means mark as unedited instead.
  20. If editing, the current message is copied into a temporary buffer, and
  21. this buffer is selected for editing.  The major mode of this buffer is
  22. controlled by the variable `vm-edit-message-mode'.
  23.  
  24. Use C-c ESC when you have finished editing the message.  The message
  25. will be inserted into its folder replacing the old version of the
  26. message.  If you don't want your edited version of the message to
  27. replace the original, use C-c C-]."
  28.   (interactive "P")
  29.   (vm-follow-summary-cursor)
  30.   (vm-select-folder-buffer)
  31.   (vm-check-for-killed-summary)
  32.   (vm-error-if-folder-read-only)
  33.   (vm-error-if-folder-empty)
  34.   (if prefix-argument
  35.       (if (vm-edited-flag (car vm-message-pointer))
  36.       (progn
  37.         (vm-set-edited-flag (car vm-message-pointer) nil)
  38.         (vm-mark-for-display-update (car vm-message-pointer))
  39.         (if (eq vm-flush-interval t)
  40.         (vm-stuff-virtual-attributes (car vm-message-pointer))
  41.           (vm-set-modflag-of (car vm-message-pointer) t))
  42.         (vm-set-buffer-modified-p t (vm-current-message-buffer))
  43.         (vm-update-summary-and-mode-line))
  44.     (message "Message has not been edited."))
  45.     (let ((mp vm-message-pointer)
  46.       (edit-buf (vm-edit-buffer-of (car vm-message-pointer)))
  47.       (folder-buffer (current-buffer))
  48.       (inhibit-quit t))
  49.       (if (not (and edit-buf (buffer-name edit-buf)))
  50.       (progn
  51.         (vm-save-restriction
  52.           (widen)
  53.           (setq edit-buf (generate-new-buffer "*VM message edit*"))
  54.           (vm-set-edit-buffer-of (car mp) edit-buf)
  55.           (copy-to-buffer edit-buf
  56.                   (save-excursion
  57.                 (goto-char (vm-start-of (car mp)))
  58.                 (forward-line 1)
  59.                 (point))
  60.                   (vm-text-end-of (car mp))))
  61.         (if (get-buffer-window edit-buf)
  62.         (select-window (get-buffer-window edit-buf))
  63.           (switch-to-buffer edit-buf))
  64.         (set-buffer-modified-p nil)
  65.         (goto-char (point-min))
  66.         (search-forward "\n\n" (point-max) t)
  67.         (funcall (or vm-edit-message-mode 'text-mode))
  68.         (setq vm-message-pointer mp
  69.           vm-mail-buffer folder-buffer)
  70.         (use-local-map (copy-keymap (or (current-local-map)
  71.                         (make-sparse-keymap))))
  72.         (vm-overlay-keymap vm-edit-message-mode-map (current-local-map))
  73.         (message "Type C-c ESC to end edit, C-c C-] to abort with no change."))
  74.     (switch-to-buffer edit-buf)))))
  75.  
  76. (defun vm-overlay-keymap (src-map dest-map)
  77.   (let ((old-local-map (current-local-map)))
  78.     (unwind-protect
  79.     (progn
  80.       (use-local-map dest-map)
  81.       (cond
  82.        ((vectorp src-map)
  83.         (let ((i (1- (length src-map))) src-b dest-b)
  84.           (while (>= i 0)
  85.         (setq src-b (aref src-map i))
  86.         (cond
  87.          ((null src-b))
  88.          ((keymapp src-b)
  89.           (setq dest-b (local-key-binding (char-to-string i)))
  90.           (if (not (keymapp dest-b))
  91.               (define-key dest-map (char-to-string i)
  92.             (setq dest-b (make-sparse-keymap))))
  93.           (vm-overlay-keymap src-b dest-b))
  94.          (t
  95.           (define-key dest-map (char-to-string i) src-b)))
  96.         (vm-decrement i))))
  97.        ((consp src-map)
  98.         (let (src-b dest-b)
  99.           (setq src-map (cdr src-map))
  100.           (while src-map
  101.         (setq src-b (cdr (car src-map)))
  102.         (cond
  103.          ((null src-b))
  104.          ((keymapp src-b)
  105.           (setq dest-b (local-key-binding
  106.                 (char-to-string (car (car src-map)))))
  107.           (if (not (keymapp dest-b))
  108.               (define-key dest-map (char-to-string (car (car src-map)))
  109.             (setq dest-b (make-sparse-keymap))))
  110.           (vm-overlay-keymap src-b dest-b))
  111.          (t
  112.           (define-key dest-map (char-to-string (car (car src-map)))
  113.             src-b)))
  114.         (setq src-map (cdr src-map)))))
  115.        ((fboundp 'map-keymap)
  116.         (let (src-b dest-b)
  117.           (map-keymap
  118.            (function
  119.         (lambda (key src-b)
  120.           (cond ((keymapp src-b)
  121.              (setq dest-b (local-key-binding (vector key)))
  122.              (if (not (keymapp dest-b))
  123.                  (define-key dest-map key
  124.                    (setq dest-b (make-sparse-keymap))))
  125.              (vm-overlay-keymap src-b dest-b))
  126.             (t
  127.              (define-key dest-map key src-b)))))
  128.            src-map)))))
  129.       (use-local-map old-local-map))))
  130.                 
  131. (defun vm-discard-cached-data (&optional count)
  132.   "Discard cached information about the current message.
  133. When VM digs information from the headers of a message, it stores it
  134. iunternally for future reference.  This command causes VM to forget this
  135. information, and VM will be forced to search the headers of the message
  136. again for these data.  VM will also have to decide again which headers
  137. should be displayed and which should not.  Therefore this command is
  138. useful if you change the value of vm-visible-headers or
  139. vm-invisible-headers in the midst of a VM session.
  140.  
  141. Numeric prefix argument N means to discard data from the current message
  142. plus the next N-1 messages.  A negative N means discard data from the
  143. current message and the previous N-1 messages.
  144.  
  145. When invoked on marked messages (via vm-next-command-uses-marks),
  146. data is discarded only from the marked messages in the current folder."
  147.   (interactive "p")
  148.   (or count (setq count 1))
  149.   (vm-follow-summary-cursor)
  150.   (vm-select-folder-buffer)
  151.   (vm-check-for-killed-summary)
  152.   (vm-error-if-folder-empty)
  153.   ;; Do this in case the user is using this command because the
  154.   ;; variables that control visible headers have been altered.
  155.   (vm-build-visible-header-alist)
  156.   (let ((mlist (vm-select-marked-or-prefixed-messages count)))
  157.     (while mlist
  158.       (vm-set-cache-of (car mlist)
  159.                (make-vector
  160.             (length (vm-cache-of (car mlist)))
  161.             nil ))
  162.       (vm-set-vheaders-of (car mlist) nil)
  163.       (vm-set-vheaders-regexp-of (car mlist) nil)
  164.       (vm-set-text-of (car mlist) nil)
  165.       (vm-mark-for-display-update (car mlist))
  166.       (setq mlist (cdr mlist))))
  167.   (vm-update-summary-and-mode-line))
  168.  
  169. (defun vm-edit-message-end ()
  170.   "End the edit of a VM mail message and copy the new version
  171. to the message's folder."
  172.   (interactive)
  173.   (if (null vm-message-pointer)
  174.       (error "This is not a VM message edit buffer."))
  175.   (if (null (buffer-name (marker-buffer (vm-end-of (car vm-message-pointer)))))
  176.       (error "The folder buffer for this message has been killed."))
  177.   (let ((edit-buf (current-buffer))
  178.     (mp vm-message-pointer))
  179.     (if (buffer-modified-p)
  180.     (let ((inhibit-quit t))
  181.       (save-excursion
  182.         (set-buffer (marker-buffer (vm-start-of (car mp))))
  183.         (if (not (memq (car mp) vm-message-list))
  184.         (error "The original copy of this message has been expunged."))
  185.         (vm-save-restriction
  186.          (widen)
  187.          (goto-char (vm-start-of (car mp)))
  188.          (forward-line 1)
  189.          (let ((vm-message-pointer mp)
  190.            vm-next-command-uses-marks
  191.            buffer-read-only)
  192.            (insert-buffer-substring edit-buf)
  193.            (and (/= (preceding-char) ?\n) (insert ?\n))
  194.            (delete-region (point) (vm-text-end-of (car mp)))
  195.            (vm-discard-cached-data))
  196.          (vm-set-edited-flag (car mp) t)
  197.          (vm-mark-for-display-update (car mp))
  198.          (if (eq vm-flush-interval t)
  199.          (vm-stuff-virtual-attributes (car mp))
  200.            (vm-set-modflag-of (car mp) t))
  201.          (vm-set-buffer-modified-p t)
  202.          (vm-clear-modification-flag-undos)
  203.          (vm-set-edit-buffer-of (car mp) nil))
  204.         (if (eq mp vm-message-pointer)
  205.         (vm-preview-current-message)
  206.           (vm-update-summary-and-mode-line))))
  207.       (message "No change."))
  208.     (set-buffer-modified-p nil)
  209.     (kill-buffer edit-buf)))
  210.  
  211. (defun vm-edit-message-abort ()
  212.   "Abort editing of a VM message, without updating the message's folder."
  213.   (interactive)
  214.   (if (null vm-message-pointer)
  215.       (error "This is not a VM message edit buffer."))
  216.   (if (null (buffer-name (marker-buffer (vm-end-of (car vm-message-pointer)))))
  217.       (error "The folder buffer for this message has been killed."))
  218.   (vm-set-edit-buffer-of (car vm-message-pointer) nil)
  219.   (set-buffer-modified-p nil)
  220.   (kill-buffer (current-buffer))
  221.   (message "Aborted, no change."))
  222.