mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-12-22 10:26:20 +00:00
1213 lines
41 KiB
EmacsLisp
1213 lines
41 KiB
EmacsLisp
;; 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 <doe@speedy.computer.com>
|
|
From: \"John Xavier Doe\" <doe@speedy.computer.com>
|
|
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 <evil laugh>
|
|
;;
|
|
(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))))))
|
|
|