🚀 go-pugleaf

RetroBBS NetNews Server

Inspired by RockSolid Light RIP Retro Guy

Article View: gnu.emacs.vm.bug
Article #9614

more reply stuff

#9614
From: Jamie Zawinski
Date: Mon, 13 May 1991 08:10
124 lines
5504 bytes
I don't really like it that when I reply to a message, each address goes on
its own line, regardless of how short the addresses are.  Here's a version of
vm-do-reply that only breaks lines when it needs to, but still only breaks
lines between addresses.

		-- Jamie

(defun vm-do-reply (to-all include-text count)
  (save-restriction
    (widen)
    (let ((mail-buffer (current-buffer))
	  (mlist (vm-select-marked-or-prefixed-messages count))
	  (dir default-directory)
	  (message-pointer vm-message-pointer)
	  to cc subject mp in-reply-to references tmp tmp2 newsgroups)
      (setq mp mlist)
      (while mp 
	(cond
	 ((eq mlist mp)
	  (cond ((setq to (vm-get-header-contents (car mp) "Reply-To")))
		((setq to (vm-get-header-contents (car mp) "From")))
		((setq to (vm-grok-From_-author (car mp))))
		(t (error "No From: or Reply-To: header in message")))
	  (setq subject (vm-get-header-contents (car mp) "Subject")
		in-reply-to (and vm-in-reply-to-format
				 (vm-sprintf 'vm-in-reply-to-format (car mp)))
		in-reply-to (and (not (equal "" in-reply-to)) in-reply-to))
	  (and subject vm-reply-subject-prefix
	       (let ((case-fold-search t))
		 (not
		  (equal
		   (string-match (regexp-quote vm-reply-subject-prefix)
				 subject)
		   0)))
	       (setq subject (concat vm-reply-subject-prefix subject))))
	 (t (cond ((setq tmp (vm-get-header-contents (car mp) "Reply-To"))
		   (setq to (concat to "," tmp)))
		  ((setq tmp (vm-get-header-contents (car mp) "From"))
		   (setq to (concat to "," tmp)))
		  ((setq tmp (vm-grok-From_-author (car mp)))
		   (setq to (concat to "," tmp)))
		  (t (error "No From: or Reply-To: header in message")))))
	(if to-all
	    (progn
	      (setq tmp (vm-get-header-contents (car mp) "To"))
	      (setq tmp2 (vm-get-header-contents (car mp) "Cc"))
	      (if tmp
		  (if cc
		      (setq cc (concat cc "," tmp))
		    (setq cc tmp)))
	      (if tmp2
		  (if cc
		      (setq cc (concat cc "," tmp2))
		    (setq cc tmp2)))))
	(setq references
	      (cons (vm-get-header-contents (car mp) "References")
		    (cons (vm-get-header-contents (car mp) "In-reply-to")
			  (cons (vm-get-header-contents (car mp) "Message-ID")
				references))))
	(setq newsgroups
	      (cons (or (and to-all (vm-get-header-contents (car mp) "Followup-To"))
			(vm-get-header-contents (car mp) "Newsgroups"))
		    newsgroups))
	(setq mp (cdr mp)))
      (if vm-strip-reply-headers
	  (let ((mail-use-rfc822 t))
	    (require 'mail-utils)
	    (and to (setq to (mail-strip-quoted-names to)))
	    (and cc (setq cc (mail-strip-quoted-names cc)))))
      (setq to (vm-parse-addresses to)
	    cc (vm-parse-addresses cc))
      (if vm-reply-ignored-addresses
	  (setq to (vm-strip-ignored-addresses to)
		cc (vm-strip-ignored-addresses cc)))
      (setq to (vm-delete-duplicates to))
      (setq cc (vm-delete-duplicates cc))
      ;; hacky change by jwz to fit as many addresses as possible on one line,
      ;; breaking lines only between addresses.
      (let* ((i 4)
	     (fn (function (lambda (addr)
		   (setq i (+ i (length addr) 2))
		   (if (< i fill-column)
		       addr
		     (setq i (+ (length addr) 6))
		     (concat "\n    " addr))))))
	(and to (setq to (mapconcat fn to ", ")))
	(setq i 4)
	(and cc (setq cc (mapconcat fn cc ", "))))
      (and (null to) (setq to cc cc nil))
      (setq references (delq nil references)
	    references (mapconcat 'identity references " ")
	    references (vm-parse references "[^<]*\\(<[^>]+>\\)")
	    references (vm-delete-duplicates references)
	    references (if references (mapconcat 'identity references "\n\t")))
      (setq newsgroups (delq nil newsgroups)
	    newsgroups (mapconcat 'identity newsgroups ",")
	    newsgroups (vm-parse newsgroups "[ \t\f\r\n,]*\\([^ \t\f\r\n,]+\\)")
	    newsgroups (vm-delete-duplicates newsgroups)
	    newsgroups (if newsgroups (mapconcat 'identity newsgroups ",")))
      (vm-mail-internal
       (format "reply to %s%s" (vm-su-full-name (car mlist))
	       (if (cdr mlist) ", ..." ""))
       to subject in-reply-to cc references newsgroups)
      (use-local-map (copy-keymap (current-local-map)))
      (local-set-key "\C-c\C-y" 'vm-yank-message)
      (local-set-key "\C-cy" 'vm-yank-message-other-folder)
      (local-set-key "\C-c\C-s" 'vm-mail-send)
      (local-set-key "\C-c\C-c" 'vm-mail-send-and-exit)
      (local-set-key "\C-c\C-v" vm-mode-map)
      (make-local-variable 'vm-reply-list)
      (setq vm-mail-buffer mail-buffer
	    vm-system-state 'replying
	    vm-message-pointer message-pointer
	    vm-reply-list mlist
	    default-directory dir)
      (if include-text
	  (save-excursion
	    (goto-char (point-min))
	    (re-search-forward (concat "^" mail-header-separator "$") nil 0)
	    (forward-char 1)
	    (while mlist
	      (vm-yank-message (car mlist))
	      (goto-char (point-max))
	      (setq mlist (cdr mlist))))))))
Technical Details
Message-ID: <9105130810.AA28112@thalidomide>
Path: arc1-ca.pugleaf.net!gmdzi!unido!mcsun!uunet!wendy-fate.uu.net!bug-vm

Show Full Headers
Complete Article Headers
X-Google-Language: ENGLISH,ASCII-7-bit
X-Google-Thread: f6829,ad5b5a45fd66e4e2,start
X-Google-Attributes: gidf6829,public
X-Google-ArrivalTime: 1991-05-13 15:23:33 PST
Path: arc1-ca.pugleaf.net!gmdzi!unido!mcsun!uunet!wendy-fate.uu.net!bug-vm
From: jwz%thalidomide@lucid.com (Jamie Zawinski)
Newsgroups: gnu.emacs.vm.bug
Subject: more reply stuff
Message-ID: <9105130810.AA28112@thalidomide>
Date: 13 May 91 08:10:10 GMT
Sender: bug-vm-request@uunet.uu.net
Lines: 124
X-Windows: The defacto substandard.