# HG changeset patch # User Jim Blandy # Date 614303726 0 # Node ID ce5567c47b8fad2e448ae5a92863e70e7bcb821c # Parent f60b88b46f97e404b9e66b8b3de41759e7ac602b Initial revision diff -r f60b88b46f97 -r ce5567c47b8f lisp/=superyank.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/=superyank.el Mon Jun 19 23:55:26 1989 +0000 @@ -0,0 +1,1212 @@ +;; superyank.el -- Version 1.1 +;; +;; Inserts the message being replied to with various user controlled +;; citation styles. +;; + +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY. No author or distributor +;; accepts responsibility to anyone for the consequences of using it +;; or for whether it serves any particular purpose or works at all, +;; unless he says so in writing. Refer to the GNU Emacs General Public +;; License for full details. + +;; Everyone is granted permission to copy, modify and redistribute +;; this file, but only under the conditions described in the +;; GNU Emacs General Public License. A copy of this license is +;; supposed to have been given to you along with GNU Emacs so you +;; can know your rights and responsibilities. It should be in a +;; file named COPYING. Among other things, the copyright notice +;; and this notice must be preserved on all copies. + +;; NAME: Barry A. Warsaw USMAIL: National Institute of Standards +;; TELE: (301) 975-3460 and Technology (formerly NBS) +;; UUCP: {...}!uunet!cme-durer!warsaw Rm. B-124, Bldg. 220 +;; ARPA: warsaw@cme.nist.gov Gaithersburg, MD 20899 + +;; Modification history: +;; +;; modified: 14-Jun-1989 baw (better keymap set procedure, rewrite-headers) +;; modified: 12-Jun-1989 baw (added defvar for sy-use-only-preference-p) +;; modified: 6-Jun-1989 baw (better sy-rewrite-headers, no kill/yank) +;; modified: 5-Jun-1989 baw (requires rnewspost.el) +;; modified: 1-Jun-1989 baw (persistent attribution, sy-open-line) +;; modified: 31-May-1989 baw (fixed some gnus problems, id'd another) +;; modified: 22-May-1989 baw (documentation) +;; modified: 8-May-1989 baw (auto filling of regions) +;; modified: 1-May-1989 baw (documentation) +;; modified: 27-Apr-1989 baw (new preference scheme) +;; modified: 24-Apr-1989 baw (remove gnus headers, attrib scheme, cite lines) +;; modified: 19-Apr-1989 baw (cite key, fill p, yank region, naming scheme) +;; modified: 12-Apr-1989 baw (incorp other mail yank features seen on net) +;; created : 16-Feb-1989 baw (mod vanilla fn indent-rigidly mail-yank-original) + +;; Though I wrote this package basically from scratch, as an elisp +;; learning exercise, it was inspired by postings of similar packages to +;; the gnu.emacs newsgroup over the past month or so. +;; +;; Here's a brief history of how this package developed: +;; +;; I as well as others on the net were pretty unhappy about the way emacs +;; cited replies with the tab or 4 spaces. It looked ugly and made it hard +;; to distinguish between original and cited lines. I hacked on the function +;; yank-original to at least give the user the ability to define the citation +;; character. I posted this simple hack, and others did as well. The main +;; difference between mine and others was that a space was put after the +;; citation string on on new citations, but not after previously cited lines: +;; +;; >> John wrote this originally +;; > Jane replied to that +;; +;; Then Martin Neitzel posted some code that he developed, derived in part +;; from code that Ashwin Ram posted previous to that. In Martin's +;; posting, he introduced a new, and (IMHO) superior, citation style, +;; eliminating nested citations. Yes, I wanted to join the Small-But- +;; Growing-Help-Stamp-Out-Nested-Citation-Movement! You should too. +;; +;; But Martin's code simply asks the user for the citation string (here +;; after called the `attribution' string), and I got to thinking, it wouldn't +;; be that difficult to automate that part. So I started hacking this out. +;; It proved to be not as simple as I first thought. But anyway here it +;; is. See the wish list below for future plans (if I have time). +;; +;; Type "C-h f mail-yank-original" after this package is loaded to get a +;; description of what it does and the variables that control it. +;; +;; ====================================================================== +;; +;; Changes wish list +;; +;; 1) C-x C-s yanks a region from the RMAIL buffer instead of the +;; whole buffer +;; +;; 2) reparse nested citations to try to recast as non-nested citations +;; perhaps by checking the References: line +;; +;; ====================================================================== +;; +;; require and provide features +;; +(require 'sendmail) +(provide 'superyank) + +;; +;; ====================================================================== +;; +;; don't need rnewspost.el to rewrite the header. This only works +;; with diffs to rnewspost.el that I posted with the original +;; superyank code. +;; +(setq news-reply-header-hook nil) + +;; ********************************************************************** +;; start of user defined variables +;; ********************************************************************** +;; +;; this section defines variables that control the operation of +;; super-mail-yank. Most of these are described in the comment section +;; as well as the DOCSTRING. +;; + +;; +;; ---------------------------------------------------------------------- +;; +;; this variable holds the default author's name for citations +;; +(defvar sy-default-attribution "Anon" + "String that describes attribution to unknown person. This string +should not contain the citation string.") + +;; +;; ---------------------------------------------------------------------- +;; +;; string used as an end delimiter for both nested and non-nested citations +;; +(defvar sy-citation-string ">" + "String to use as an end-delimiter for citations. This string is +used in both nested and non-nested citations. For best results, use a +single character with no trailing space. Most commonly used string +is: \">\.") + +;; +;; ---------------------------------------------------------------------- +;; +;; variable controlling citation type, nested or non-nested +;; +(defvar sy-nested-citation-p nil + "Non-nil uses nested citations, nil uses non-nested citations. +Nested citations are of the style: + +I wrote this +> He wrote this +>> She replied to something he wrote + +Non-nested citations are of the style: + +I wrote this +John> He wrote this +Jane> She originally wrote this") + + +;; +;; ---------------------------------------------------------------------- +;; +;; regular expression that matches existing citations +;; +(defvar sy-cite-regexp "[a-zA-Z0-9]*>" + "Regular expression that describes how an already cited line in an +article begins. The regexp is only used at the beginning of a line, +so it doesn't need to begin with a '^'.") + +;; +;; ---------------------------------------------------------------------- +;; +;; regular expression that delimits names from titles in the field that +;; looks like: (John X. Doe -- Computer Hacker Extraordinaire) +;; +(defvar sy-titlecue-regexp "\\s +-+\\s +" + + "Regular expression that delineates names from titles in the name +field. Often, people will set up their name field to look like this: + +(John Xavier Doe -- Computer Hacker Extraordinaire) + +Set to nil to treat entire field as a name.") + +;; +;; ---------------------------------------------------------------------- +;; +;; +(defvar sy-preferred-attribution 2 + + "This is an integer indicating what the user's preference is in +attribution style, based on the following key: + +0: email address name is preferred +1: initials are preferred +2: first name is preferred +3: last name is preferred + +The value of this variable may also be greater than 3, which would +allow you to prefer the 2nd through nth - 1 name. If the preferred +attribution is nil or the empty string, then the secondary preferrence +will be the first name. After that, the entire name alist is search +until a non-empty, non-nil name is found. If no such name is found, +then the user is either queried or the default attribution string is +used depending on the value of sy-confirm-always-p. + +Examples: + +assume the from: line looks like this: + +from: doe@computer.some.where.com (John Xavier Doe) + +The following preferences would return these strings: + +0: \"doe\" +1: \"JXD\" +2: \"John\" +3: \"Doe\" +4: \"Xavier\" + +anything else would return \"John\".") + +;; +;; ---------------------------------------------------------------------- +;; +(defvar sy-confirm-always-p t + "If t, always confirm attribution string before inserting into +buffer.") + + +;; +;; ---------------------------------------------------------------------- +;; +;; informative header hook +;; +(defvar sy-rewrite-header-hook 'sy-header-on-said + "Hook for inserting informative header at the top of the yanked +message. Set to nil for no header. Here is a list of predefined +header styles; you can use these as a model to write you own: + +sy-header-on-said [default]: On 14-Jun-1989 GMT, + John Xavier Doe said: + +sy-header-inarticle-writes: In article <123456789> John Xavier Doe writes: + +sy-header-regarding-writes: Regarding RE: superyank; John Xavier Doe adds: + +sy-header-verbose: On 14-Jun-1989 GMT, John Xavier Doe + from the organization Great Company + has this to say about article <123456789> + in newsgroups misc.misc + concerning RE: superyank + referring to previous articles <987654321> + +You can use the following variables as information strings in your header: + +sy-reply-yank-date: the date field [ex: 14-Jun-1989 GMT] +sy-reply-yank-from: the from field [ex: John Xavier Doe] +sy-reply-yank-message-id: the message id [ex: <123456789>] +sy-reply-yank-subject: the subject line [ex: RE: superyank] +sy-reply-yank-newsgroup: the newsgroup name for GNUS [ex: misc.misc] +sy-reply-yank-references: the article references [ex: <987654321>] +sy-reply-yank-organization: the author's organization [ex: Great Company] + +If a field can't be found, because it doesn't exist or is not being +shown, perhaps because of toggle-headers, the corresponding field +variable will contain the string \"mumble mumble\".") + +;; +;; ---------------------------------------------------------------------- +;; +;; non-nil means downcase the author's name string +;; +(defvar sy-downcase-p nil + "Non-nil means downcase the author's name string.") + +;; +;; ---------------------------------------------------------------------- +;; +;; controls removal of leading white spaces +;; +(defvar sy-left-justify-p nil + "If non-nil, delete all leading white space before citing.") + +;; +;; ---------------------------------------------------------------------- +;; +;; controls auto filling of region +;; +(defvar sy-auto-fill-region-p nil + "If non-nil, automatically fill each paragraph that is cited. If +nil, do not auto fill each paragraph.") + + +;; +;; ---------------------------------------------------------------------- +;; +;; controls use of preferred attribution only, or use of attribution search +;; scheme if the preferred attrib can't be found. +;; +(defvar sy-use-only-preference-p nil + + "If non-nil, then only the preferred attribution string will be +used. If the preferred attribution string can not be found, then the +sy-default-attribution will be used. If nil, and the preferred +attribution string is not found, then some secondary scheme will be +employed to find a suitable attribution string.") + +;; ********************************************************************** +;; end of user defined variables +;; ********************************************************************** + +;; +;; ---------------------------------------------------------------------- +;; +;; The new citation style means we can clean out other headers in addition +;; to those previously cleaned out. Anyway, we create our own headers. +;; Also, we want to clean out any headers that gnus puts in. Add to this +;; for other mail or news readers you may be using. +;; +(setq mail-yank-ignored-headers "^via:\\|^origin:\\|^status:\\|^re\\(mail\\|ceiv\\)ed\\|^[a-z-]*message-id:\\|^\\(summary-\\)?line[s]?:\\|^cc:\\|^subject:\\|^\\(\\(in-\\)?reply-\\)?to:\\|^\\(\\(return\\|reply\\)-\\)?path:\\|^\\(posted-\\)?date:\\|^\\(mail-\\)?from:\\|^newsgroup[s]?:\\|^organization:\\|^keywords:\\|^distribution:\\|^references:") + +;; +;; ---------------------------------------------------------------------- +;; +;; global variables, not user accessable +;; +(setq sy-persist-attribution (concat sy-default-attribution "> ")) +(setq sy-reply-yank-date "") +(setq sy-reply-yank-from "") +(setq sy-reply-yank-message-id "") +(setq sy-reply-yank-subject "") +(setq sy-reply-yank-newsgroups "") +(setq sy-reply-yank-references "") +(setq sy-reply-yank-organization "") + +;; +;; ====================================================================== +;; +;; This section contains primitive functions used in the schemes. They +;; extract name fields from various parts of the "from:" field based on +;; the control variables described above. +;; +;; Some will use recursion to pick out the correct namefield in the namestring +;; or the list of initials. These functions all scan a string that contains +;; the name, ie: "John Xavier Doe". There is no limit on the number of names +;; in the string. Also note that all white spaces are basically ignored and +;; are stripped from the returned strings, and titles are ignored if +;; sy-titlecue-regexp is set to non-nil. +;; +;; Others will use methods to try to extract the name from the email +;; address of the originator. The types of addresses readable are +;; described above. + +;; +;; ---------------------------------------------------------------------- +;; +;; try to extract the name from an email address of the form +;; name%[stuff] +;; +;; Unlike the get-name functions above, these functions operate on the +;; buffer instead of a supplied name-string. +;; +(defun sy-%-style-address () + (beginning-of-line) + (buffer-substring + (progn (re-search-forward "%" (point-max) t) + (if (not (bolp)) (forward-char -1)) + (point)) + (progn (re-search-backward "^\\|[^a-zA-Z0-9]") + (point)))) + +;; +;; ---------------------------------------------------------------------- +;; +;; try to extract names from addresses with the form: +;; [stuff]name@[stuff] +;; +(defun sy-@-style-address () + (beginning-of-line) + (buffer-substring + (progn (re-search-forward "@" (point-max) t) + (if (not (bolp)) (forward-char -1)) + (point)) + (progn (re-search-backward "^\\|[^a-zA-Z0-0]") + (if (not (bolp)) (forward-char 1)) + (point)))) + +;; +;; ---------------------------------------------------------------------- +;; +;; try to extract the name from addresses with the form: +;; [stuff]![stuff]...!name[stuff] +;; +(defun sy-!-style-address () + (beginning-of-line) + (buffer-substring + (progn (while (re-search-forward "!" (point-max) t)) + (point)) + (progn (re-search-forward "[^a-zA-Z0-9]\\|$") + (if (not (eolp)) (forward-char -1)) + (point)))) + +;; +;; ---------------------------------------------------------------------- +;; +;; using the different email name schemes, try each one until you get a +;; non-nil entry +;; +(defun sy-get-emailname () + (let ((en1 (sy-%-style-address)) + (en2 (sy-@-style-address)) + (en3 (sy-!-style-address))) + (cond + ((not (string-equal en1 "")) en1) + ((not (string-equal en2 "")) en2) + ((not (string-equal en3 "")) en3) + (t "")))) + +;; +;; ---------------------------------------------------------------------- +;; +;; returns the "car" of the namestring, really the first namefield +;; +;; (sy-string-car "John Xavier Doe") +;; => "John" +;; +(defun sy-string-car (namestring) + (substring namestring + (progn (string-match "\\s *" namestring) (match-end 0)) + (progn (string-match "\\s *\\S +" namestring) (match-end 0)))) + +;; +;; ---------------------------------------------------------------------- +;; +;; returns the "cdr" of the namestring, really the whole string from +;; after the first name field to the end of the string. +;; +;; (sy-string-cdr "John Xavier Doe") +;; => "Xavier Doe" +;; +(defun sy-string-cdr (namestring) + (substring namestring + (progn (string-match "\\s *\\S +\\s *" namestring) + (match-end 0)))) + +;; +;; ---------------------------------------------------------------------- +;; +;; convert a namestring to a list of namefields +;; +;; (sy-namestring-to-list "John Xavier Doe") +;; => ("John" "Xavier" "Doe") +;; +(defun sy-namestring-to-list (namestring) + (if (not (string-match namestring "")) + (append (list (sy-string-car namestring)) + (sy-namestring-to-list (sy-string-cdr namestring))))) + +;; +;; ---------------------------------------------------------------------- +;; +;; strip the initials from each item in the list and return a string +;; that is the concatenation of the initials +;; +(defun sy-strip-initials (raw-nlist) + (if (not raw-nlist) + nil + (concat (substring (car raw-nlist) 0 1) + (sy-strip-initials (cdr raw-nlist))))) + + +;; +;; ---------------------------------------------------------------------- +;; +;; using the namestring, build a list which is in the following order +;; +;; (email, initials, firstname, lastname, name1, name2, name3 ... nameN-1) +;; +(defun sy-build-ordered-namelist (namestring) + (let* ((raw-nlist (sy-namestring-to-list namestring)) + (initials (sy-strip-initials raw-nlist)) + (firstname (car raw-nlist)) + (revnames (reverse (cdr raw-nlist))) + (lastname (car revnames)) + (midnames (reverse (cdr revnames))) + (emailnames (sy-get-emailname))) + (append (list emailnames) + (list initials) + (list firstname) + (list lastname) + midnames))) + +;; +;; ---------------------------------------------------------------------- +;; +;; Query the user for the attribution string. Supply sy-default-attribution +;; as the default choice. +;; +(defun sy-query-for-attribution () + (concat + (let* ((prompt (concat "Enter attribution string: (default " + sy-default-attribution + ") ")) + (query (read-input prompt)) + (attribution (if (string-equal query "") + sy-default-attribution + query))) + (if sy-downcase-p + (downcase attribution) + attribution)) + sy-citation-string)) + + +;; +;; ---------------------------------------------------------------------- +;; +;; parse the current line for the namestring +;; +(defun sy-get-namestring () + (save-restriction + (beginning-of-line) + (if (re-search-forward "(.*)" (point-max) t) + (let ((start (progn + (beginning-of-line) + (re-search-forward "\\((\\s *\\)\\|$" (point-max) t) + (point))) + (end (progn + (re-search-forward + (concat "\\(\\s *\\()\\|" sy-titlecue-regexp "\\)\\)\\|$") + (point-max) t) + (point)))) + (narrow-to-region start end) + (let ((start (progn + (beginning-of-line) + (point))) + (end (progn + (end-of-line) + (re-search-backward + (concat "\\s *\\()\\|" sy-titlecue-regexp "\\)$") + (point-min) t) + (point)))) + (buffer-substring start end))) + (let ((start (progn + (beginning-of-line) + (re-search-forward "^\"*") + (point))) + (end (progn + (re-search-forward "\\(\\s *[a-zA-Z0-9\\.]+\\)*" + (point-max) t) + (point)))) + (buffer-substring start end))))) + + +;; +;; ---------------------------------------------------------------------- +;; +;; scan the nlist and return the integer pointing to the first legal +;; non-empty namestring. Returns the integer pointing to the index +;; in the nlist of the preferred namestring, or nil if no legal +;; non-empty namestring could be found. +;; +(defun sy-return-preference-n (nlist) + (let ((p sy-preferred-attribution) + (exception nil)) + ;; + ;; check to be sure the index is not out-of-bounds + ;; + (cond + ((< p 0) (setq p 2) (setq exception t)) + ((not (nth p nlist)) (setq p 2) (setq exception t))) + ;; + ;; check to be sure that the explicit preference is not empty + ;; + (if (string-equal (nth p nlist) "") + (progn (setq p 0) + (setq exception t))) + ;; + ;; find the first non-empty namestring + ;; + (while (and (nth p nlist) + (string-equal (nth p nlist) "")) + (setq exception t) + (setq p (+ p 1))) + ;; + ;; return the preference index if non-nil, otherwise nil + ;; + (if (or (and exception sy-use-only-preference-p) + (not (nth p nlist))) + nil + p))) + +;; +;; +;; ---------------------------------------------------------------------- +;; +;; rebuild the nlist into an alist for completing-read. Use as a guide +;; the index of the preferred name field. Get the actual preferred +;; name field base on other factors (see above). If no actual preferred +;; name field is found, then query the user for the attribution string. +;; +;; also note that the nlist is guaranteed to be non-empty. At the very +;; least it will consist of 4 empty strings ("" "" "" "") +;; +(defun sy-nlist-to-alist (nlist) + (let ((preference (sy-return-preference-n nlist)) + alist + (n 0)) + ;; + ;; check to be sure preference is not nil + ;; + (if (not preference) + (setq alist (list (cons (sy-query-for-attribution) nil))) + ;; + ;; preference is non-nil + ;; + (setq alist (list (cons (nth preference nlist) nil))) + (while (nth n nlist) + (if (= n preference) nil + (setq alist (append alist (list (cons (nth n nlist) nil))))) + (setq n (+ n 1)))) + alist)) + + + +;; +;; ---------------------------------------------------------------------- +;; +;; confirm if desired after the alist has been built +;; +(defun sy-get-attribution (alist) + (concat + ;; + ;; check to see if nested citations are to be used + ;; + (if sy-nested-citation-p + "" + ;; + ;; check to see if confirmation is needed + ;; if not, just return the preference (first element in alist) + ;; + (if (not sy-confirm-always-p) + (car (car alist)) + ;; + ;; confirmation is requested so build the prompt, confirm + ;; and return the chosen string + ;; + (let* (ignore + (prompt (concat "Complete attribution string: (default " + (car (car alist)) + ") ")) + ;; + ;; set up the local completion keymap + ;; + (minibuffer-local-must-match-map + (let ((map (make-sparse-keymap))) + (define-key map "?" 'minibuffer-completion-help) + (define-key map " " 'minibuffer-complete-word) + (define-key map "\t" 'minibuffer-complete) + (define-key map "\00A" 'exit-minibuffer) + (define-key map "\00D" 'exit-minibuffer) + (define-key map "\007" + '(lambda () + (interactive) + (beep) + (exit-minibuffer))) + map)) + ;; + ;; read the completion + ;; + (attribution (completing-read prompt alist)) + ;; + ;; check attribution string for emptyness + ;; + (choice (if (or (not attribution) + (string-equal attribution "")) + (car (car alist)) + attribution))) + + (if sy-downcase-p + (downcase choice) + choice)))) + sy-citation-string)) + + +;; +;; ---------------------------------------------------------------------- +;; +;; this function will scan the current rmail buffer, narrowing it to the +;; from: line, then using this, it will try to decipher some names from +;; that line. It will then build the name alist and try to confirm +;; its choice of attribution strings. It returns the chosen attribution +;; string. +;; +(defun sy-scan-rmail-for-names (rmailbuffer) + (save-excursion + (let ((case-fold-search t) + alist + attribution) + (switch-to-buffer rmailbuffer) + (goto-char (point-min)) + ;; + ;; be sure there is a from: line + ;; + (if (not (re-search-forward "^from:\\s *" (point-max) t)) + (setq attribution (sy-query-for-attribution)) + ;; + ;; if there is a from: line, then scan the narrow the buffer, + ;; grab the namestring, and build the alist, then using this + ;; get the attribution string. + ;; + (save-restriction + (narrow-to-region (point) + (progn (end-of-line) (point))) + (let* ((namestring (sy-get-namestring)) + (nlist (sy-build-ordered-namelist namestring))) + (setq alist (sy-nlist-to-alist nlist)))) + ;; + ;; we've built the alist, now confirm the attribution choice + ;; if appropriate + ;; + (setq attribution (sy-get-attribution alist))) + attribution))) + + +;; +;; ====================================================================== +;; +;; the following function insert of citations, writing of headers, filling +;; paragraphs and general higher level operations +;; + +;; +;; ---------------------------------------------------------------------- +;; +;; insert a nested citation +;; +(defun sy-insert-citation (start end cite-string) + (save-excursion + (goto-char end) + (setq end (point-marker)) + (goto-char start) + (or (bolp) + (forward-line 1)) + + (let ((fill-prefix (concat cite-string " ")) + (fstart (point)) + (fend (point))) + + (while (< (point) end) + ;; + ;; remove leading tabs if desired + ;; + (if sy-left-justify-p + (delete-region (point) + (progn (skip-chars-forward " \t") (point)))) + ;; + ;; check to see if the current line should be cited + ;; + (if (or (eolp) + (looking-at sy-cite-regexp)) + ;; + ;; do not cite this line unless nested-citations are to be + ;; used + ;; + (progn + (or (eolp) + (if sy-nested-citation-p + (insert cite-string))) + + ;; set fill start and end points + ;; + (or (= fstart fend) + (not sy-auto-fill-region-p) + (progn (goto-char fend) + (or (not (eolp)) + (setq fend (+ fend 1))) + (fill-region-as-paragraph fstart fend))) + (setq fstart (point)) + (setq fend (point))) + + ;; else + ;; + (insert fill-prefix) + (end-of-line) + (setq fend (point))) + + (forward-line 1))) + (move-marker end nil))) + +;; +;; ---------------------------------------------------------------------- +;; +;; yank a particular field into a holding variable +;; +(defun sy-yank-fields (start) + (save-excursion + (goto-char start) + (setq sy-reply-yank-date (mail-fetch-field "date") + sy-reply-yank-from (mail-fetch-field "from") + sy-reply-yank-subject (mail-fetch-field "subject") + sy-reply-yank-newsgroups (mail-fetch-field "newsgroups") + sy-reply-yank-references (mail-fetch-field "references") + sy-reply-yank-message-id (mail-fetch-field "message-id") + sy-reply-yank-organization (mail-fetch-field "organization")) + (or sy-reply-yank-date + (setq sy-reply-yank-date "mumble mumble")) + (or sy-reply-yank-from + (setq sy-reply-yank-from "mumble mumble")) + (or sy-reply-yank-subject + (setq sy-reply-yank-subject "mumble mumble")) + (or sy-reply-yank-newsgroups + (setq sy-reply-yank-newsgroups "mumble mumble")) + (or sy-reply-yank-references + (setq sy-reply-yank-references "mumble mumble")) + (or sy-reply-yank-message-id + (setq sy-reply-yank-message-id "mumble mumble")) + (or sy-reply-yank-organization + (setq sy-reply-yank-organization "mumble mumble")))) + +;; +;; ---------------------------------------------------------------------- +;; +;; rewrite the header to be more conversational +;; +(defun sy-rewrite-headers (start) + (goto-char start) + (run-hooks 'sy-rewrite-header-hook)) + +;; +;; ---------------------------------------------------------------------- +;; +;; some different styles of headers +;; +(defun sy-header-on-said () + (insert-string "\nOn " sy-reply-yank-date ",\n" + sy-reply-yank-from " said:\n")) + +(defun sy-header-inarticle-writes () + (insert-string "\nIn article " sy-reply-yank-message-id + " " sy-reply-yank-from " writes:\n")) + +(defun sy-header-regarding-writes () + (insert-string "\nRegarding " sy-reply-yank-subject + "; " sy-reply-yank-from " adds:\n")) + +(defun sy-header-verbose () + (insert-string "\nOn " sy-reply-yank-date ",\n" + sy-reply-yank-from "\nfrom the organization " + sy-reply-yank-organization "\nhad this to say about article " + sy-reply-yank-message-id "\nin newsgroups " + sy-reply-yank-newsgroups "\nconcerning " + sy-reply-yank-subject "\nreferring to previous articles " + sy-reply-yank-references "\n")) + +;; +;; ---------------------------------------------------------------------- +;; +;; yank the original article in and attribute +;; +(defun sy-yank-original (arg) + + "Insert the message being replied to, if any (in rmail/gnus). Puts +point before the text and mark after. Calls generalized citation +function sy-insert-citation to cite all allowable lines." + + (interactive "P") + (if mail-reply-buffer + (let* ((sy-confirm-always-p (if (consp arg) + t + sy-confirm-always-p)) + (attribution (sy-scan-rmail-for-names mail-reply-buffer)) + (top (point)) + (start (point)) + (end (progn (delete-windows-on mail-reply-buffer) + (insert-buffer mail-reply-buffer) + (mark)))) + + (sy-yank-fields start) + (sy-rewrite-headers start) + (setq start (point)) + (mail-yank-clear-headers top (mark)) + (setq sy-persist-attribution (concat attribution " ")) + (sy-insert-citation start end attribution)) + + (goto-char top) + (exchange-point-and-mark))) + + +;; +;; ---------------------------------------------------------------------- +;; +;; this is here for compatibility with existing mail/news yankers +;; overloads the default mail-yank-original +;; +(defun mail-yank-original (arg) + + "Yank original message buffer into the reply buffer, citing as per +user preferences. Numeric Argument forces confirmation. + +Here is a description of the superyank.el package, what it does and +what variables control its operation. This was written by Barry +Warsaw (warsaw@cme.nist.gov, {...}!uunet!cme-durer!warsaw). + +A 'Citation' is the acknowledgement of the original author of a mail +message. There are two general forms of citation. In 'nested +citations', indication is made that the cited line was written by +someone *other* that the current message author (or by that author at +an earlier time). No indication is made as to the identity of the +original author. Thus, a nested citation after multiple replies would +look like this (this is after my reply to a previous message): + +>>John originally wrote this +>>and this as well +> Jane said that John didn't know +> what he was talking about +And that's what I think as well. + +In non-nested citations, you won't see multiple \">\" characters at +the beginning of the line. Non-nested citations will insert an +informative string at the beginning of a cited line, attributing that +line to an author. The same message described above might look like +this if non-nested citations were used: + +John> John originally wrote this +John> and this as well +Jane> Jane said that John didn't know +Jane> what he was talking about +And that's what I think as well. + +Notice that my inclusion of Jane's inclusion of John's original +message did not result in a cited line of the form: Jane>John>. Thus +no nested citations. The style of citation is controlled by the +variable `sy-nested-citation-p'. Nil uses non-nested citations and +non-nil uses old style, nested citations. + +The variable `sy-citation-string' is the string to use as a marker for +a citation, either nested or non-nested. For best results, this +string should be a single character with no trailing space and is +typically the character \">\". In non-nested citations this string is +appended to the attribution string (author's name), along with a +trailing space. In nested citations, a trailing space is only added +to a first level citation. + +Another important variable is `sy-cite-regexp' which describes strings +that indicate a previously cited line. This regular expression is +always used at the beginning of a line so it doesn't need to begin +with a \"^\" character. Change this variable if you change +`sy-citation-string'. + +The following section only applies to non-nested citations. + +This package has a fair amount of intellegence related to deciphering +the author's name based on information provided by the original +message buffer. In normal operation, the program will pick out the +author's first and last names, initials, terminal email address and +any other names it can find. It will then pick an attribution string +from this list based on a user defined preference and it will ask for +confirmation if the user specifies. This package gathers its +information from the `From:' line of the original message buffer. It +recognizes From: lines with the following forms: + +From: John Xavier Doe +From: \"John Xavier Doe\" +From: doe@speedy.computer.com (John Xavier Doe) +From: computer!speedy!doe (John Xavier Doe) +From: computer!speedy!doe (John Xavier Doe) +From: doe%speedy@computer.com (John Xavier Doe) + +In this case, if confirmation is requested, the following strings will +be made available for completion and confirmation: + +\"John\" +\"Xavier\" +\"Doe\" +\"JXD\" +\"doe\" + +Note that completion is case sensitive. If there was a problem +picking out a From: line, or any other problem getting even a single +name, then the user will be queried for an attribution string. The +default attribution string is set in the variable +`sy-default-attribution'. + +Sometimes people set their name fields so that it also includes a +title of the form: + +From: doe@speedy.computer.com (John Doe -- Hacker Extraordinaire) + +To avoid the inclusion of the string \"-- Hacker Extraordinaire\" in +the name list, the variable `sy-titlecue-regexp' is provided. Its +default setting will still properly recognize names of the form: + +From: xdoe@speedy.computer.com (John Xavier-Doe -- Crazed Hacker) + +The variable `sy-preferred-attribution' contains an integer that +indicates which name field the user prefers to use as the attribution +string, based on the following key: + +0: email address name is preferred +1: initials are preferred +2: first name is preferred +3: last name is preferred + +The value can be greater than 3, in which case, you would be +preferring the 2nd throught nth -1 name. In any case, if the +preferred name can't be found, then one of two actions will be taken +depending on the value of the variable `sy-use-only-preference-p'. If +this is non-nil, then the `sy-default-attribution will be used. If it +is nil, then a secondary scheme will be employed to find a suitable +attribution scheme. First, the author's first name will be used. If +that can't be found than the name list is searched for the first +non-nil, non-empty name string. If still no name can be found, then +the user is either queried, or the `sy-default-attribution' is used, +depending on the value of `sy-confirm-always-p'. + +If the variable `sy-confirm-always-p' is non-nil, superyank will always +confirm the attribution string with the user before inserting it into +the reply buffer. Confirmation is with completion, but the completion +list is merely a suggestion; the user can override the list by typing +in a string of their choice. + +The variable `sy-rewrite-header-hook' is a hook that contains a lambda +expression which rewrites the informative header at the top of the +yanked message. Set to nil to avoid writing any header. + +You can make superyank autofill each paragraph it cites by setting the +variable `sy-auto-fill-region-p' to non-nil. Or set the variable to nil +and fill the paragraphs manually with sy-fill-paragraph-manually (see +below). + +Finally, `sy-downcase-p' if non-nil, indicates that you always want to +downcase the attribution string before insertion, and +`sy-left-justify-p', if non-nil, indicates that you want to delete all +leading white space before citing. + +Since the almost all yanking in other modes (RMAIL, GNUS) is done +through the function `mail-yank-original', and since superyank +overloads this function, cited yanking is automatically bound to the +C-c C-y key. There are three other smaller functions that are +provided with superyank and they are bound as below. Try C-h f on +each function to get more information on these functions. + +Key Bindings: + +C-c C-y mail-yank-original (superyank's version) +C-c q sy-fill-paragraph-manually +C-c C-q sy-fill-paragraph-manually +C-c i sy-insert-persist-attribution +C-c C-i sy-insert-persist-attribution +C-c C-o sy-open-line + + +Summary of variables, with their default values: + +sy-default-attribution (default: \"Anon\") + Attribution to use if no attribution string can be deciphered + from the original message buffer. + +sy-citation-string (default: \">\") + String to append to the attribution string for citation, for + best results, it should be one character with no trailing space. + +sy-nested-citation-p (default: nil) + Nil means use non-nested citations, non-nil means use old style + nested citations. + +sy-cite-regexp (default: \"[a-zA-Z0-9]*>\") + Regular expression that matches the beginning of a previously + cited line. Always used at the beginning of a line so it does + not need to start with a \"^\" character. + +sy-titlecue-regexp (default: \"\\s +-+\\s +\") + Regular expression that matches a title delimiter in the name + field. + +sy-preferred-attribution (default: 2) + Integer indicating user's preferred attribution field. + +sy-confirm-always-p (default: t) + Non-nil says always confirm with completion before inserting + attribution. + +sy-rewrite-header-hook (default: 'sy-header-on-said) + Hook for inserting informative header at the top of the yanked + message. + +sy-downcase-p (default: nil) + Non-nil says downcase the attribution string before insertion. + +sy-left-justify-p (default: nil) + Non-nil says delete leading white space before citing. + +sy-auto-fill-region-p (default: nil) + Non-nil says don't auto fill the region. T says auto fill the + paragraph. + +sy-use-only-preference-p (default: nil) + If nil, use backup scheme when preferred attribution string + can't be found. If non-nil and preferred attribution string + can't be found, then use sy-default-attribution." + + (interactive "P") + + (local-set-key "\C-cq" 'sy-fill-paragraph-manually) + (local-set-key "\C-c\C-q" 'sy-fill-paragraph-manually) + (local-set-key "\C-c\i" 'sy-insert-persist-attribution) + (local-set-key "\C-c\C-i" 'sy-insert-persist-attribution) + (local-set-key "\C-c\C-o" 'sy-open-line) + + (sy-yank-original arg)) + + +;; +;; ---------------------------------------------------------------------- +;; +;; based on Bruce Israel's "fill-paragraph-properly", and modified from +;; code posted by David C. Lawrence. Modified to use the persistant +;; attribution if none could be found from the paragraph. +;; +(defun sy-fill-paragraph-manually (arg) + "Fill paragraph containing or following point, automatically finding +the sy-cite-regexp and using it as the prefix. If the sy-cite-regexp +is not in the first line of the paragraph, it makes a guess at what +the fill-prefix for the paragraph should be by looking at the first +line and taking anything up to the first alphanumeric character. + +Prefix arg means justify both sides of paragraph as well. + +This function just does fill-paragraph if the fill-prefix is set. If +what it deduces to be the paragraph prefix (based on the first line) +does not precede each line in the region, then the persistant +attribution is used. The persistant attribution is just the last +attribution string used to cite lines." + + (interactive "P") + (save-excursion + (forward-paragraph) + (or (bolp) + (newline 1)) + + (let ((end (point)) + st + (fill-prefix fill-prefix)) + (backward-paragraph) + (if (looking-at "\n") + (forward-char 1)) + (setq st (point)) + (if fill-prefix + nil + (untabify st end) ;; die, scurvy tabs! + ;; + ;; untabify might have made the paragraph longer character-wise, + ;; make sure end reflects the correct location of eop. + ;; + (forward-paragraph) + (setq end (point)) + (goto-char st) + (if (looking-at sy-cite-regexp) + (setq fill-prefix (concat + (buffer-substring + st (progn (re-search-forward sy-cite-regexp) + (point))) + " ")) + ;; + ;; this regexp is is convenient because paragraphs quoted by simple + ;; indentation must still yield to us + ;; + (while (looking-at "[^a-zA-Z0-9]") + (forward-char 1)) + (setq fill-prefix (buffer-substring st (point)))) + (next-line 1) (beginning-of-line) + (while (and (< (point) end) + (not (string-equal fill-prefix ""))) + ;; + ;; if what we decided was the fill-prefix does not precede all + ;; of the lines in the paragraph, we probably goofed. In this + ;; case set it to the persistant attribution. + ;; + (if (looking-at (regexp-quote fill-prefix)) + () + (setq fill-prefix sy-persist-attribution)) + (next-line 1) + (beginning-of-line))) + (fill-region-as-paragraph st end arg)))) + +;; +;; ---------------------------------------------------------------------- +;; +;; insert the persistant attribution at point +;; +(defun sy-insert-persist-attribution () + "Insert the persistant attribution at the beginning of the line that +point is on. This string is the last attribution confirmed and used +in the yanked reply buffer." + (interactive) + (save-excursion + (beginning-of-line) + (insert-string sy-persist-attribution))) + + +;; +;; ---------------------------------------------------------------------- +;; +;; open a line putting the attribution at the beginning + +(defun sy-open-line (arg) + "Insert a newline and leave point before it. Also inserts the +persistant attribution at the beginning of the line. With arg, +inserts that many newlines." + (interactive "p") + (save-excursion + (let ((start (point))) + (open-line arg) + (goto-char start) + (forward-line) + (while (< 0 arg) + (sy-insert-persist-attribution) + (forward-line 1) + (setq arg (- arg 1)))))) +