home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #27 / NN_1992_27.iso / spool / alt / lucidem / help / 705 < prev    next >
Encoding:
Text File  |  1992-11-19  |  4.4 KB  |  104 lines
  1. x-gateway: rodan.UU.NET from help-lucid-emacs to alt.lucid-emacs.help; Thu, 19 Nov 1992 09:04:24 EST
  2. Date: Thu, 19 Nov 1992 14:02:58 GMT
  3. From: djh@CIS.Prime.COM (David Hughes)
  4. Message-ID: <9211191402.AA11997@CIS.Prime.COM>
  5. Subject: vm-reply.el
  6. Newsgroups: alt.lucid-emacs.help
  7. Path: sparky!uunet!wendy-fate.uu.net!help-lucid-emacs
  8. Sender: help-lucid-emacs-request@lucid.com
  9. Lines: 93
  10.  
  11. Kyle,
  12.  
  13.     Here is a patch for two functions in vm-reply which do not work properly
  14. if the user sets vm-included-text-prefix to nil or to "" (in the latter case
  15. in goes into a nasty loop).
  16.  
  17. --
  18. Regards, David
  19.  
  20. (defun vm-mail-yank-default (message)
  21.   (save-excursion
  22.     (delete-region (point) (progn (search-forward "\n\n") (point)))
  23.     (if vm-included-text-attribution-format
  24.     (insert (vm-sprintf 'vm-included-text-attribution-format message)))
  25.     (let ((zmacs-regions nil))
  26.       (if (and (stringp vm-included-text-prefix)
  27.                (not (zerop (length vm-included-text-prefix))))
  28.           (while (and (re-search-forward "^" nil t) (< (point) (mark)))
  29.             (replace-match vm-included-text-prefix t t))))))
  30.  
  31. (defun vm-yank-message (message &optional prefix)
  32.   "Yank message number N into the current buffer at point.
  33. When called interactively N is always read from the minibuffer.  When
  34. called non-interactively the first argument is expected to be a message
  35. struct.
  36.  
  37. This command is meant to be used in VM created Mail mode buffers; the
  38. yanked message comes from the mail buffer containing the message you
  39. are replying to, forwarding, or invoked VM's mail command from.
  40.  
  41. All message headers are yanked along with the text.  Point is left
  42. before the inserted text, the mark after.  Any hook functions bound to
  43. mail-yank-hooks are run, aftert inserting the text and setting point
  44. and mark.
  45.  
  46. Prefix arg means to ignore mail-yank-hooks, don't set the mark, prepend the
  47. value of vm-included-text-prefix to every yanked line, and don't yank any
  48. headers other than those specified in vm-visible-headers/vm-invisible-headers."
  49.   (interactive
  50.    (list
  51.     ;; What we really want for the first argument is a message struct,
  52.     ;; but if called interactively, we let the user type in a message
  53.     ;; number instead.
  54.     (let (mp default (result 0) prompt)
  55.       (save-excursion
  56.         (vm-select-folder-buffer)
  57.         (setq default (and vm-message-pointer
  58.                            (vm-number-of (car vm-message-pointer)))
  59.               prompt (if default
  60.                          (format "Yank message number: (default %s) "
  61.                                  default)
  62.                        "Yank message number: "))
  63.         (while (zerop result)
  64.           (setq result (read-string prompt))
  65.           (and (string= result "") default (setq result default))
  66.           (setq result (string-to-int result)))
  67.         (if (null (setq mp (nthcdr (1- result) vm-message-list)))
  68.             (error "No such message.")))
  69.       (car mp))
  70.     current-prefix-arg ))
  71.   (if (not (bufferp vm-mail-buffer))
  72.       (error "This is not a VM Mail mode buffer."))
  73.   (if (null (buffer-name vm-mail-buffer))
  74.       (error "The mail buffer containing message %d has been killed."
  75.              (vm-number-of message)))
  76.   (let ((b (current-buffer)) (start (point)) mp end)
  77.     (save-restriction
  78.       (widen)
  79.       (save-excursion
  80.         (set-buffer (marker-buffer (vm-start-of message)))
  81.         (save-restriction
  82.           (widen)
  83.           (append-to-buffer b (if prefix
  84.                                   (vm-vheaders-of message)
  85.                                 (vm-start-of message))
  86.                             (vm-text-end-of message))
  87.           (setq end (vm-marker (+ start (- (vm-text-end-of message)
  88.                                            (if prefix
  89.                                                (vm-vheaders-of message)
  90.                                              (vm-start-of message)))) b))))
  91.       (if prefix
  92.           (save-excursion
  93.             (if (and (stringp vm-included-text-prefix)
  94.                      (not (zerop (length vm-included-text-prefix))))
  95.                 (while (and (< (point) end) (re-search-forward "^" end t))
  96.                   (replace-match vm-included-text-prefix t t)
  97.                   (forward-line))))
  98.         ;; Delete UNIX From or MMDF ^A^A^A^A line
  99.         (delete-region (point) (progn (forward-line) (point)))
  100.         (push-mark end)
  101.         (if mail-yank-hooks
  102.             (run-hooks 'mail-yank-hooks)
  103.           (vm-mail-yank-default message))))))
  104.