home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Internet Tools 1993 July / Internet Tools.iso / RockRidge / mail / vm / vm-5.33beta / vm-edit.el < prev    next >
Encoding:
Text File  |  1991-04-06  |  7.9 KB  |  208 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.        (t
  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.       (use-local-map old-local-map))))
  116.                 
  117. (defun vm-discard-cached-data (&optional count)
  118.   "Discard cached information about the current message.
  119. When VM digs information from the headers of a message, it stores it
  120. iunternally for future reference.  This command causes VM to forget this
  121. information, and VM will be forced to search the headers of the message
  122. again for these data.  VM will also have to decide again which headers
  123. should be displayed and which should not.  Therefore this command is
  124. useful if you change the value of vm-visible-headers or
  125. vm-invisible-headers in the midst of a VM session.
  126.  
  127. Numeric prefix argument N means to discard data from the current message
  128. plus the next N-1 messages.  A negative N means discard data from the
  129. current message and the previous N-1 messages.
  130.  
  131. When invoked on marked messages (via vm-next-command-uses-marks),
  132. data is discarded only from the marked messages in the current folder."
  133.   (interactive "p")
  134.   (or count (setq count 1))
  135.   (vm-follow-summary-cursor)
  136.   (vm-select-folder-buffer)
  137.   (vm-check-for-killed-summary)
  138.   (vm-error-if-folder-empty)
  139.   ;; Do this in case the user is using this command because the
  140.   ;; variables that control visible headers have been altered.
  141.   (vm-build-visible-header-alist)
  142.   (let ((mlist (vm-select-marked-or-prefixed-messages count)))
  143.     (while mlist
  144.       (vm-set-cache-of (car mlist)
  145.                (make-vector
  146.             (length (vm-cache-of (car mlist)))
  147.             nil ))
  148.       (vm-set-vheaders-of (car mlist) nil)
  149.       (vm-set-vheaders-regexp-of (car mlist) nil)
  150.       (vm-set-text-of (car mlist) nil)
  151.       (vm-mark-for-display-update (car mlist))
  152.       (setq mlist (cdr mlist))))
  153.   (vm-update-summary-and-mode-line))
  154.  
  155. (defun vm-edit-message-end ()
  156.   "End the edit of a VM mail message and copy the new version
  157. to the message's folder."
  158.   (interactive)
  159.   (if (null vm-message-pointer)
  160.       (error "This is not a VM message edit buffer."))
  161.   (if (null (buffer-name (marker-buffer (vm-end-of (car vm-message-pointer)))))
  162.       (error "The folder buffer for this message has been killed."))
  163.   (let ((edit-buf (current-buffer))
  164.     (mp vm-message-pointer))
  165.     (if (buffer-modified-p)
  166.     (let ((inhibit-quit t))
  167.       (save-excursion
  168.         (set-buffer (marker-buffer (vm-start-of (car mp))))
  169.         (if (not (memq (car mp) vm-message-list))
  170.         (error "The original copy of this message has been expunged."))
  171.         (vm-save-restriction
  172.          (widen)
  173.          (goto-char (vm-start-of (car mp)))
  174.          (forward-line 1)
  175.          (let ((vm-message-pointer mp)
  176.            vm-next-command-uses-marks
  177.            buffer-read-only)
  178.            (insert-buffer-substring edit-buf)
  179.            (and (/= (preceding-char) ?\n) (insert ?\n))
  180.            (delete-region (point) (vm-text-end-of (car mp)))
  181.            (vm-discard-cached-data))
  182.          (vm-set-edited-flag (car mp) t)
  183.          (vm-mark-for-display-update (car mp))
  184.          (if (eq vm-flush-interval t)
  185.          (vm-stuff-virtual-attributes (car mp))
  186.            (vm-set-modflag-of (car mp) t))
  187.          (vm-set-buffer-modified-p t)
  188.          (vm-clear-modification-flag-undos)
  189.          (vm-set-edit-buffer-of (car mp) nil))
  190.         (if (eq mp vm-message-pointer)
  191.         (vm-preview-current-message)
  192.           (vm-update-summary-and-mode-line))))
  193.       (message "No change."))
  194.     (set-buffer-modified-p nil)
  195.     (kill-buffer edit-buf)))
  196.  
  197. (defun vm-edit-message-abort ()
  198.   "Abort editing of a VM message, without updating the message's folder."
  199.   (interactive)
  200.   (if (null vm-message-pointer)
  201.       (error "This is not a VM message edit buffer."))
  202.   (if (null (buffer-name (marker-buffer (vm-end-of (car vm-message-pointer)))))
  203.       (error "The folder buffer for this message has been killed."))
  204.   (vm-set-edit-buffer-of (car vm-message-pointer) nil)
  205.   (set-buffer-modified-p nil)
  206.   (kill-buffer (current-buffer))
  207.   (message "Aborted, no change."))
  208.