supercite.el 67.8 KB
Newer Older
Richard M. Stallman's avatar
Richard M. Stallman committed
1 2
;;; supercite.el --- minor mode for citing mail and news replies

3
;; Copyright (C) 1993, 1997, 2001-2012 Free Software Foundation, Inc.
4

Richard M. Stallman's avatar
Richard M. Stallman committed
5
;; Author: 1993 Barry A. Warsaw <bwarsaw@python.org>
6
;; Maintainer:    Glenn Morris <rgm@gnu.org>
Richard M. Stallman's avatar
Richard M. Stallman committed
7
;; Created:       February 1993
Richard M. Stallman's avatar
Richard M. Stallman committed
8
;; Keywords: mail, news
Richard M. Stallman's avatar
Richard M. Stallman committed
9 10 11

;; This file is part of GNU Emacs.

12
;; GNU Emacs is free software: you can redistribute it and/or modify
Richard M. Stallman's avatar
Richard M. Stallman committed
13
;; it under the terms of the GNU General Public License as published by
14 15
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
Richard M. Stallman's avatar
Richard M. Stallman committed
16 17 18 19 20 21 22

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
23
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
Richard M. Stallman's avatar
Richard M. Stallman committed
24 25

;; LCD Archive Entry
26
;; supercite|Barry A. Warsaw|supercite-help@python.org
Richard M. Stallman's avatar
Richard M. Stallman committed
27 28 29
;; |Mail and news reply citation package
;; |1993/09/22 18:58:46|3.1|

30 31 32
;;; Commentary:

;;; Code:
Richard M. Stallman's avatar
Richard M. Stallman committed
33 34 35 36 37 38 39


(require 'regi)

;; start user configuration variables
;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv

40
(defgroup supercite nil
41
  "Supercite package."
42 43 44 45 46
  :prefix "sc-"
  :group 'mail
  :group 'news)

(defgroup supercite-frames nil
47
  "Supercite (regi) frames."
48 49 50 51
  :prefix "sc-"
  :group 'supercite)

(defgroup supercite-attr nil
52
  "Supercite attributions."
53 54 55 56
  :prefix "sc-"
  :group 'supercite)

(defgroup supercite-cite nil
57
  "Supercite citings."
58 59 60 61
  :prefix "sc-"
  :group 'supercite)

(defgroup supercite-hooks nil
62
  "Hooking into supercite."
63 64 65 66
  :prefix "sc-"
  :group 'supercite)

(defcustom sc-auto-fill-region-p t
67
  "If non-nil, automatically fill each paragraph after it has been cited."
68 69 70 71
  :type 'boolean
  :group 'supercite)

(defcustom sc-blank-lines-after-headers 1
72
  "Number of blank lines to leave after mail headers have been nuked.
73 74 75 76 77 78
Set to nil, to use whatever blank lines happen to occur naturally."
  :type '(choice (const :tag "leave" nil)
		 integer)
  :group 'supercite)

(defcustom sc-citation-leader "    "
79
  "String comprising first part of a citation."
80 81
  :type 'string
  :group 'supercite-cite)
Richard M. Stallman's avatar
Richard M. Stallman committed
82

83
(defcustom sc-citation-delimiter ">"
84
  "String comprising third part of a citation.
85 86 87 88 89
This string is used in both nested and non-nested citations."
  :type 'string
  :group 'supercite-cite)

(defcustom sc-citation-separator " "
90
  "String comprising fourth and last part of a citation."
91 92
  :type 'string
  :group 'supercite-cite)
Richard M. Stallman's avatar
Richard M. Stallman committed
93

94
(defcustom sc-citation-leader-regexp "[ \t]*"
95
  "Regexp describing citation leader for a cited line.
96 97 98
This should NOT have a leading `^' character."
  :type 'regexp
  :group 'supercite-cite)
Richard M. Stallman's avatar
Richard M. Stallman committed
99 100 101

;; Nemacs and Mule users note: please see the texinfo manual for
;; suggestions on setting these variables.
Dave Love's avatar
Dave Love committed
102
(defcustom sc-citation-root-regexp "[-._[:alnum:]]*"
103
  "Regexp describing variable root part of a citation for a cited line.
Richard M. Stallman's avatar
Richard M. Stallman committed
104
This should NOT have a leading `^' character.  See also
105 106 107 108
`sc-citation-nonnested-root-regexp'."
  :type 'regexp
  :group 'supercite-cite)

Dave Love's avatar
Dave Love committed
109
(defcustom sc-citation-nonnested-root-regexp "[-._[:alnum:]]+"
110
  "Regexp describing the variable root part of a nested citation.
Richard M. Stallman's avatar
Richard M. Stallman committed
111
This should NOT have a leading `^' character.  This variable is
112
related to `sc-citation-root-regexp' but whereas that variable
Richard M. Stallman's avatar
Richard M. Stallman committed
113
describes both nested and non-nested citation roots, this variable
114 115 116 117 118
describes only nested citation roots."
  :type 'regexp
  :group 'supercite-cite)

(defcustom sc-citation-delimiter-regexp "[>]+"
119
  "Regexp describing citation delimiter for a cited line.
120 121 122 123 124
This should NOT have a leading `^' character."
  :type 'regexp
  :group 'supercite-cite)

(defcustom sc-citation-separator-regexp "[ \t]*"
125
  "Regexp describing citation separator for a cited line.
126 127 128
This should NOT have a leading `^' character."
  :type 'regexp
  :group 'supercite-cite)
Richard M. Stallman's avatar
Richard M. Stallman committed
129

130
(defcustom sc-cite-blank-lines-p nil
131
  "If non-nil, put a citation on blank lines."
132 133
  :type 'boolean
  :group 'supercite-cite)
Richard M. Stallman's avatar
Richard M. Stallman committed
134

135
(defcustom sc-cite-frame-alist '()
136
  "Alist for frame selection during citing.
Richard M. Stallman's avatar
Richard M. Stallman committed
137 138 139 140 141 142
Each element of this list has the following form:
   (INFOKEY ((REGEXP . FRAME)
             (REGEXP . FRAME)
             (...)))

Where INFOKEY is a key for `sc-mail-field', REGEXP is a regular
Juri Linkov's avatar
Juri Linkov committed
143 144 145
expression to match against the INFOKEY's value.  FRAME is
a citation frame, or a symbol that represents the name of
a variable whose value is a citation frame."
146 147 148 149
  :type '(repeat (list symbol (repeat (cons regexp
					    (choice (repeat (repeat sexp))
						    symbol)))))
  :group 'supercite-frames)
150
(put 'sc-cite-frame-alist 'risky-local-variable t)
151 152

(defcustom sc-uncite-frame-alist '()
153
  "Alist for frame selection during unciting.
154 155 156 157 158
See the variable `sc-cite-frame-alist' for details."
  :type '(repeat (list symbol (repeat (cons regexp
					    (choice (repeat (repeat sexp))
						    symbol)))))
  :group 'supercite-frames)
159
(put 'sc-uncite-frame-alist 'risky-local-variable t)
160 161

(defcustom sc-recite-frame-alist '()
162
  "Alist for frame selection during reciting.
163 164 165 166 167
See the variable `sc-cite-frame-alist' for details."
  :type '(repeat (list symbol (repeat (cons regexp
					    (choice (repeat (repeat sexp))
						    symbol)))))
  :group 'supercite-frames)
168
(put 'sc-recite-frame-alist 'risky-local-variable t)
Richard M. Stallman's avatar
Richard M. Stallman committed
169

170
(defcustom sc-default-cite-frame
Richard M. Stallman's avatar
Richard M. Stallman committed
171 172 173 174 175 176 177 178 179 180
  '(;; initialize fill state and temporary variables when entering
    ;; frame. this makes things run much faster
    (begin (progn
	     (sc-fill-if-different)
	     (setq sc-tmp-nested-regexp (sc-cite-regexp "")
		   sc-tmp-nonnested-regexp (sc-cite-regexp)
		   sc-tmp-dumb-regexp
		   (concat "\\("
			   (sc-cite-regexp "")
			   "\\)"
181 182
			   (sc-cite-regexp
			    sc-citation-nonnested-root-regexp)))))
Richard M. Stallman's avatar
Richard M. Stallman committed
183 184 185 186
    ;; blank lines mean paragraph separators, so fill the last cited
    ;; paragraph, unless sc-cite-blank-lines-p is non-nil, in which
    ;; case we treat blank lines just like any other line.
    ("^[ \t]*$"                 (if sc-cite-blank-lines-p
187 188 189
				    (if sc-nested-citation-p
					(sc-add-citation-level)
				      (sc-cite-line))
Richard M. Stallman's avatar
Richard M. Stallman committed
190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210
				  (sc-fill-if-different "")))
    ;; do nothing if looking at a reference tag. make sure that the
    ;; tag string isn't the empty string since this will match every
    ;; line.  it cannot be nil.
    (sc-reference-tag-string    (if (string= sc-reference-tag-string "")
				    (list 'continue)
				  nil))
    ;; this regexp catches nested citations in which the author cited
    ;; a non-nested citation with a dumb citer.
    (sc-tmp-dumb-regexp         (sc-cite-coerce-dumb-citer))
    ;; if we are looking at a nested citation then add a citation level
    (sc-tmp-nested-regexp       (sc-add-citation-level))
    ;; if we're looking at a non-nested citation, coerce it to our style
    (sc-tmp-nonnested-regexp    (sc-cite-coerce-cited-line))
    ;; we must be looking at an uncited line. if we are in nested
    ;; citations, just add a citation level
    (sc-nested-citation-p       (sc-add-citation-level))
    ;; we're looking at an uncited line and we are in non-nested
    ;; citations, so cite it with a non-nested citation
    (t                          (sc-cite-line))
    ;; be sure when we're done that we fill the last cited paragraph.
211
    (end                        (sc-fill-if-different "")))
212
  "Default REGI frame for citing a region."
213 214
  :type '(repeat (repeat sexp))
  :group 'supercite-frames)
215
(put 'sc-default-cite-frame 'risky-local-variable t)
Richard M. Stallman's avatar
Richard M. Stallman committed
216

217
(defcustom sc-default-uncite-frame
Richard M. Stallman's avatar
Richard M. Stallman committed
218 219 220
  '(;; do nothing on a blank line
    ("^[ \t]*$"       nil)
    ;; if the line is cited, uncite it
221
    ((sc-cite-regexp) (sc-uncite-line)))
222
  "Default REGI frame for unciting a region."
223 224
  :type '(repeat (repeat sexp))
  :group 'supercite-frames)
225
(put 'sc-default-uncite-frame 'risky-local-variable t)
Richard M. Stallman's avatar
Richard M. Stallman committed
226

227
(defcustom sc-default-recite-frame
Richard M. Stallman's avatar
Richard M. Stallman committed
228 229 230 231 232 233 234 235 236
  '(;; initialize fill state when entering frame
    (begin            (sc-fill-if-different))
    ;; do nothing on a blank line
    ("^[ \t]*$"       nil)
    ;; if we're looking at a cited line, recite it
    ((sc-cite-regexp) (sc-recite-line (sc-cite-regexp)))
    ;; otherwise, the line is uncited, so just cite it
    (t                (sc-cite-line))
    ;; be sure when we're done that we fill the last cited paragraph.
237
    (end              (sc-fill-if-different "")))
238
  "Default REGI frame for reciting a region."
239 240
  :type '(repeat (repeat sexp))
  :group 'supercite-frames)
241
(put 'sc-default-recite-frame 'risky-local-variable t)
Richard M. Stallman's avatar
Richard M. Stallman committed
242

243
(defcustom sc-cite-region-limit t
244
  "This variable controls automatic citation of yanked text.
245
Valid values are:
Richard M. Stallman's avatar
Richard M. Stallman committed
246 247 248 249 250 251 252

non-nil   -- cite the entire region, regardless of its size
nil       -- do not cite the region at all
<integer> -- a number indicating the threshold for citation.  When
	     the number of lines in the region is greater than this
	     value, a warning message will be printed and the region
	     will not be cited.  Lines in region are counted with
253
	     `count-lines'.
Richard M. Stallman's avatar
Richard M. Stallman committed
254 255 256 257

The gathering of attribution information is not affected by the value
of this variable.  The number of lines in the region is calculated
*after* all mail headers are removed.  This variable is only consulted
258
during the initial citing via `sc-cite-original'."
259 260 261
  :type '(choice (const :tag "do not cite" nil)
		 (integer :tag "citation threshold")
		 (other :tag "always cite" t))
262 263 264
  :group 'supercite-cite)

(defcustom sc-confirm-always-p t
265
  "If non-nil, always confirm attribution string before citing text body."
266 267 268 269
  :type 'boolean
  :group 'supercite-attr)

(defcustom sc-default-attribution "Anon"
270
  "String used when author's attribution cannot be determined."
271 272 273
  :type 'string
  :group 'supercite-attr)
(defcustom sc-default-author-name "Anonymous"
274
  "String used when author's name cannot be determined."
275 276 277
  :type 'string
  :group 'supercite-attr)
(defcustom sc-downcase-p nil
278
  "Non-nil means downcase the attribution and citation strings."
279 280 281 282
  :type 'boolean
  :group 'supercite-attr
  :group 'supercite-cite)
(defcustom sc-electric-circular-p t
283
  "If non-nil, treat electric references as circular."
284 285 286 287
  :type 'boolean
  :group 'supercite-attr)

(defcustom sc-electric-mode-hook nil
288
  "Hook for `sc-electric-mode' electric references mode."
289 290 291
  :type 'hook
  :group 'supercite-hooks)
(defcustom sc-electric-references-p nil
292
  "Use electric references if non-nil."
293 294 295 296
  :type 'boolean
  :group 'supercite)

(defcustom sc-fixup-whitespace-p nil
297
  "If non-nil, delete all leading white space before citing."
298 299 300 301
  :type 'boolean
  :group 'supercite)

(defcustom sc-load-hook nil
302
  "Hook which gets run once after Supercite loads."
303 304 305
  :type 'hook
  :group 'supercite-hooks)
(defcustom sc-pre-hook nil
306
  "Hook which gets run before each invocation of `sc-cite-original'."
307 308 309
  :type 'hook
  :group 'supercite-hooks)
(defcustom sc-post-hook nil
310
  "Hook which gets run after each invocation of `sc-cite-original'."
311 312 313 314
  :type 'hook
  :group 'supercite-hooks)

(defcustom sc-mail-warn-if-non-rfc822-p t
315
  "Warn if mail headers don't conform to RFC822."
316 317 318
  :type 'boolean
  :group 'supercite-attr)
(defcustom sc-mumble ""
319
  "Value returned by `sc-mail-field' if field isn't in mail headers."
320 321 322 323
  :type 'string
  :group 'supercite-attr)

(defcustom sc-name-filter-alist
Richard M. Stallman's avatar
Richard M. Stallman committed
324 325 326 327
  '(("^\\(Mr\\|Mrs\\|Ms\\|Dr\\)[.]?$" . 0)
    ("^\\(Jr\\|Sr\\)[.]?$" . last)
    ("^ASTS$" . 0)
    ("^[I]+$" . last))
328
  "Name list components which are filtered out as noise.
Richard M. Stallman's avatar
Richard M. Stallman committed
329 330 331 332 333 334 335
This variable contains an association list where each element is of
the form:  (REGEXP . POSITION).

REGEXP is a regular expression which matches the name list component.
Match is performed using `string-match'.  POSITION is the position in
the name list which can match the regular expression, starting at zero
for the first element.  Use `last' to match the last element in the
336 337 338 339
list and `any' to match all elements."
  :type '(repeat (cons regexp (choice (const last) (const any)
				      (integer :tag "position"))))
  :group 'supercite-attr)
Richard M. Stallman's avatar
Richard M. Stallman committed
340

341
(defcustom sc-nested-citation-p nil
342
  "Controls whether to use nested or non-nested citation style.
343 344 345
Non-nil uses nested citations, nil uses non-nested citations."
  :type 'boolean
  :group 'supercite)
Richard M. Stallman's avatar
Richard M. Stallman committed
346

347
(defcustom sc-nuke-mail-headers 'all
348
  "Controls mail header nuking.
349
Used in conjunction with `sc-nuke-mail-header-list'.  Valid values are:
Richard M. Stallman's avatar
Richard M. Stallman committed
350 351 352 353

`all'       -- nuke all mail headers
`none'      -- don't nuke any mail headers
`specified' -- nuke headers specified in `sc-nuke-mail-header-list'
354 355 356 357
`keep'      -- keep headers specified in `sc-nuke-mail-header-list'"
  :type '(choice (const all) (const none)
		 (const specified) (const keep))
  :group 'supercite)
Richard M. Stallman's avatar
Richard M. Stallman committed
358

359
(defcustom sc-nuke-mail-header-list nil
360
  "List of mail header regexps to remove or keep in body of reply.
Richard M. Stallman's avatar
Richard M. Stallman committed
361
This list contains regular expressions describing the mail headers to
362 363 364
keep or nuke, depending on the value of `sc-nuke-mail-headers'."
  :type '(repeat regexp)
  :group 'supercite)
Richard M. Stallman's avatar
Richard M. Stallman committed
365

366
(defcustom sc-preferred-attribution-list
Richard M. Stallman's avatar
Richard M. Stallman committed
367
  '("sc-lastchoice" "x-attribution" "firstname" "initials" "lastname")
368
  "Specifies what to use as the attribution string.
Richard M. Stallman's avatar
Richard M. Stallman committed
369 370 371 372 373 374 375 376 377 378 379 380 381 382
Supercite creates a list of possible attributions when it scans the
mail headers from the original message.  Each attribution choice is
associated with a key in an attribution alist.  Supercite tries to
pick a \"preferred\" attribution by matching the attribution alist
keys against the elements in `sc-preferred-attribution-list' in order.
The first non-empty string value found is used as the preferred
attribution.

Note that Supercite now honors the X-Attribution: mail field.  If
present in the original message, the value of this field should always
be used to select the most preferred attribution since it reflects how
the original author would like to be distinguished.  It should be
considered bad taste to put any attribution preference key before
\"x-attribution\" in this list, except perhaps for \"sc-lastchoice\"
Richard M. Stallman's avatar
Richard M. Stallman committed
383
\(see below).
Richard M. Stallman's avatar
Richard M. Stallman committed
384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403

Supercite remembers the last attribution used when reciting an already
cited paragraph.  This attribution will always be saved with the
\"sc-lastchoice\" key, which can be used in this list.  Note that the
last choice is always reset after every call of `sc-cite-original'.

Barring error conditions, the following preferences are always present
in the attribution alist:

\"emailname\"    -- email terminus name
\"initials\"     -- initials of author
\"firstname\"    -- first name of author
\"lastname\"     -- last name of author
\"middlename-1\" -- first middle name of author
\"middlename-2\" -- second middle name of author
...

Middle name indexes can be any positive integer greater than 0,
although it is unlikely that many authors will supply more than one
middle name, if that many.  The string of all middle names is
404 405 406
associated with the key \"middlenames\"."
  :type '(repeat string)
  :group 'supercite-attr)
Richard M. Stallman's avatar
Richard M. Stallman committed
407

408
(defcustom sc-attrib-selection-list nil
409
  "An alist for selecting preferred attribution based on mail headers.
Richard M. Stallman's avatar
Richard M. Stallman committed
410 411 412 413 414 415 416
Each element of this list has the following form:

   (INFOKEY ((REGEXP . ATTRIBUTION)
             (REGEXP . ATTRIBUTION)
             (...)))

Where INFOKEY is a key for `sc-mail-field', REGEXP is a regular
417 418
expression to match against the INFOKEY's value.  ATTRIBUTION can be a
string or a list.  If it's a string, then it is the attribution that is
Richard M. Stallman's avatar
Richard M. Stallman committed
419 420 421 422
selected by `sc-select-attribution'.  If it is a list, it is `eval'd
and the return value must be a string, which is used as the selected
attribution.  Note that the variable `sc-preferred-attribution-list'
must contain an element of the string \"sc-consult\" for this variable
423
to be consulted during attribution selection."
424 425 426 427
  :type '(repeat (list string
		       (repeat (cons regexp
				     (choice (sexp :tag "List to eval")
					     string)))))
428
  :group 'supercite-attr)
429
(put 'sc-attrib-selection-list 'risky-local-variable t)
430 431

(defcustom sc-attribs-preselect-hook nil
432
  "Hook to run before selecting an attribution."
433 434 435 436
  :type 'hook
  :group 'supercite-attr
  :group 'supercite-hooks)
(defcustom sc-attribs-postselect-hook nil
437
  "Hook to run after selecting an attribution, but before confirmation."
438 439 440 441 442
  :type 'hook
  :group 'supercite-attr
  :group 'supercite-hooks)

(defcustom sc-pre-cite-hook nil
443
  "Hook to run before citing a region of text."
444 445 446 447
  :type 'hook
  :group 'supercite-cite
  :group 'supercite-hooks)
(defcustom sc-pre-uncite-hook nil
448
  "Hook to run before unciting a region of text."
449 450 451 452
  :type 'hook
  :group 'supercite-cite
  :group 'supercite-hooks)
(defcustom sc-pre-recite-hook nil
453
  "Hook to run before reciting a region of text."
454 455 456 457 458
  :type 'hook
  :group 'supercite-cite
  :group 'supercite-hooks)

(defcustom sc-preferred-header-style 4
459
  "Index into `sc-rewrite-header-list' specifying preferred header style.
460 461 462
Index zero accesses the first function in the list."
  :type 'integer
  :group 'supercite)
Richard M. Stallman's avatar
Richard M. Stallman committed
463

464
(defcustom sc-reference-tag-string ">>>>> "
465
  "String used at the beginning of built-in reference headers."
466 467
  :type 'string
  :group 'supercite)
Richard M. Stallman's avatar
Richard M. Stallman committed
468

469
(defcustom sc-rewrite-header-list
Richard M. Stallman's avatar
Richard M. Stallman committed
470 471 472 473 474 475 476
  '((sc-no-header)
    (sc-header-on-said)
    (sc-header-inarticle-writes)
    (sc-header-regarding-adds)
    (sc-header-attributed-writes)
    (sc-header-author-writes)
    (sc-header-verbose)
477
    (sc-no-blank-line-or-header))
478
  "List of reference header rewrite functions.
Richard M. Stallman's avatar
Richard M. Stallman committed
479 480
The variable `sc-preferred-header-style' controls which function in
this list is chosen for automatic reference header insertions.
481 482 483
Electric reference mode will cycle through this list of functions."
  :type '(repeat sexp)
  :group 'supercite)
484
(put 'sc-rewrite-header-list 'risky-local-variable t)
Richard M. Stallman's avatar
Richard M. Stallman committed
485

486
(defcustom sc-titlecue-regexp "\\s +-+\\s +"
487
  "Regular expression describing the separator between names and titles.
488 489 490 491
Set to nil to treat entire field as a name."
  :type '(choice (const :tag "entire field as name" nil)
		 regexp)
  :group 'supercite-attr)
Richard M. Stallman's avatar
Richard M. Stallman committed
492

493
(defcustom sc-use-only-preference-p nil
494
  "Controls what happens when the preferred attribution cannot be found.
Richard M. Stallman's avatar
Richard M. Stallman committed
495 496
If non-nil, then `sc-default-attribution' will be used.  If nil, then
some secondary scheme will be employed to find a suitable attribution
497 498 499
string."
  :type 'boolean
  :group 'supercite-attr)
Richard M. Stallman's avatar
Richard M. Stallman committed
500

501 502 503 504 505
(defcustom sc-mode-map-prefix "\C-c\C-p"
  "Key binding to install Supercite keymap."
  :type 'string
  :group 'supercite)

Richard M. Stallman's avatar
Richard M. Stallman committed
506 507 508 509 510 511 512 513 514
;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
;; end user configuration variables

(defvar sc-mail-info nil
  "Alist of mail header information gleaned from reply buffer.")
(defvar sc-attributions nil
  "Alist of attributions for use when citing.")

(defvar sc-tmp-nested-regexp nil
515
  "Temporary regexp describing nested citations.")
Richard M. Stallman's avatar
Richard M. Stallman committed
516 517 518 519 520 521 522 523 524 525 526 527
(defvar sc-tmp-nonnested-regexp nil
  "Temporary regexp describing non-nested citations.")
(defvar sc-tmp-dumb-regexp nil
  "Temp regexp describing non-nested citation cited with a nesting citer.")

(make-variable-buffer-local 'sc-mail-info)
(make-variable-buffer-local 'sc-attributions)


;; ======================================================================
;; supercite keymaps

528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546
(defvar sc-T-keymap
  (let ((map (make-sparse-keymap)))
    (define-key map "a" 'sc-S-preferred-attribution-list)
    (define-key map "b" 'sc-T-mail-nuke-blank-lines)
    (define-key map "c" 'sc-T-confirm-always)
    (define-key map "d" 'sc-T-downcase)
    (define-key map "e" 'sc-T-electric-references)
    (define-key map "f" 'sc-T-auto-fill-region)
    (define-key map "h" 'sc-T-describe)
    (define-key map "l" 'sc-S-cite-region-limit)
    (define-key map "n" 'sc-S-mail-nuke-mail-headers)
    (define-key map "N" 'sc-S-mail-header-nuke-list)
    (define-key map "o" 'sc-T-electric-circular)
    (define-key map "p" 'sc-S-preferred-header-style)
    (define-key map "s" 'sc-T-nested-citation)
    (define-key map "u" 'sc-T-use-only-preferences)
    (define-key map "w" 'sc-T-fixup-whitespace)
    (define-key map "?" 'sc-T-describe)
    map)
Richard M. Stallman's avatar
Richard M. Stallman committed
547
  "Keymap for sub-keymap of setting and toggling functions.")
548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563

(defvar sc-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map "c"    'sc-cite-region)
    (define-key map "f"    'sc-mail-field-query)
    (define-key map "g"    'sc-mail-process-headers)
    (define-key map "h"    'sc-describe)
    (define-key map "i"    'sc-insert-citation)
    (define-key map "o"    'sc-open-line)
    (define-key map "r"    'sc-recite-region)
    (define-key map "\C-p" 'sc-raw-mode-toggle)
    (define-key map "u"    'sc-uncite-region)
    (define-key map "w"    'sc-insert-reference)
    (define-key map "\C-t"  sc-T-keymap)
    (define-key map "?"    'sc-describe)
    map)
Richard M. Stallman's avatar
Richard M. Stallman committed
564
  "Keymap for Supercite quasi-mode.")
565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581

(defvar sc-electric-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map "p"    'sc-eref-prev)
    (define-key map "n"    'sc-eref-next)
    (define-key map "s"    'sc-eref-setn)
    (define-key map "j"    'sc-eref-jump)
    (define-key map "x"    'sc-eref-abort)
    (define-key map "q"    'sc-eref-abort)
    (define-key map "\r"   'sc-eref-exit)
    (define-key map "\n"   'sc-eref-exit)
    (define-key map "g"    'sc-eref-goto)
    (define-key map "?"    'describe-mode)
    (define-key map "\C-h" 'describe-mode)
    (define-key map [f1]   'describe-mode)
    (define-key map [help] 'describe-mode)
    map)
Richard M. Stallman's avatar
Richard M. Stallman committed
582
  "Keymap for `sc-electric-mode' electric references mode.")
583 584 585 586 587 588 589


(defvar sc-minibuffer-local-completion-map
  (let ((map (copy-keymap minibuffer-local-completion-map)))
    (define-key map "\C-t" 'sc-toggle-fn)
    (define-key map " "    'self-insert-command)
    map)
Richard M. Stallman's avatar
Richard M. Stallman committed
590
  "Keymap for minibuffer confirmation of attribution strings.")
591 592 593 594 595

(defvar sc-minibuffer-local-map
  (let ((map (copy-keymap minibuffer-local-map)))
    (define-key map "\C-t" 'sc-toggle-fn)
    map)
Richard M. Stallman's avatar
Richard M. Stallman committed
596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611
  "Keymap for minibuffer confirmation of attribution strings.")


;; ======================================================================
;; utility functions

(defun sc-ask (alist)
  "Ask a question in the minibuffer requiring a single character answer.
This function is kind of an extension of `y-or-n-p' where a single
letter is used to answer a question.  Question is formed from ALIST
which has members of the form:  (WORD . LETTER).  WORD is the long
word form, while LETTER is the letter for selecting that answer.  The
selected letter is returned, or nil if the question was not answered.
Note that WORD is a string and LETTER is a character.  All LETTERs in
the list should be unique."
  (let* ((prompt (concat
612
		  (mapconcat (lambda (elt) (car elt)) alist ", ")
Richard M. Stallman's avatar
Richard M. Stallman committed
613 614
		  "? ("
		  (mapconcat
615
		   (lambda (elt) (char-to-string (cdr elt))) alist "/")
Richard M. Stallman's avatar
Richard M. Stallman committed
616 617 618
		  ") "))
	 (p prompt)
	 (event
619
	  (if (fboundp 'allocate-event)
Richard M. Stallman's avatar
Richard M. Stallman committed
620 621 622 623 624 625
	      (allocate-event)
	    nil)))
    (while (stringp p)
      (if (let ((cursor-in-echo-area t)
		(inhibit-quit t))
	    (message "%s" p)
626
	    (setq event (read-event))
Richard M. Stallman's avatar
Richard M. Stallman committed
627 628 629
	    (prog1 quit-flag (setq quit-flag nil)))
	  (progn
	    (message "%s%s" p (single-key-description event))
630 631
	    (if (fboundp 'deallocate-event)
		(deallocate-event event))
Richard M. Stallman's avatar
Richard M. Stallman committed
632 633 634
	    (setq quit-flag nil)
	    (signal 'quit '())))
      (let ((char
635
	     (if (featurep 'xemacs)
Richard M. Stallman's avatar
Richard M. Stallman committed
636 637 638 639 640 641 642 643 644 645
		 (let* ((key (and (key-press-event-p event) (event-key event)))
			(char (and key (event-to-character event))))
		   char)
	       event))
	    elt)
	(if char (setq char (downcase char)))
	(cond
	 ((setq elt (rassq char alist))
	  (message "%s%s" p (car elt))
	  (setq p (cdr elt)))
646 647
	 ((if (fboundp 'button-release-event-p)
	      (button-release-event-p event)) ; ignore them
Richard M. Stallman's avatar
Richard M. Stallman committed
648 649 650
	  nil)
	 (t
	  (message "%s%s" p (single-key-description event))
651
	  (if (featurep 'xemacs)
Richard M. Stallman's avatar
Richard M. Stallman committed
652 653 654 655 656
	      (ding nil 'y-or-n-p)
	    (ding))
	  (discard-input)
	  (if (eq p prompt)
	      (setq p (concat "Try again.  " prompt)))))))
657 658
    (if (fboundp 'deallocate-event)
	(deallocate-event event))
Richard M. Stallman's avatar
Richard M. Stallman committed
659 660 661 662 663 664 665 666 667 668
    p))

(defun sc-scan-info-alist (alist)
  "Find a match in the info alist that matches a regexp in ALIST."
  (let ((sc-mumble "")
	rtnvalue)
    (while alist
      (let* ((elem    (car alist))
	     (infokey (car elem))
	     (infoval (sc-mail-field infokey))
669
	     (mlist   (cadr elem)))
Richard M. Stallman's avatar
Richard M. Stallman committed
670 671 672 673 674 675
	(while mlist
	  (let* ((ml-elem (car mlist))
		 (regexp  (car ml-elem))
		 (thing   (cdr ml-elem)))
	    (if (string-match regexp infoval)
		;; we found a match, time to return
676
		(setq rtnvalue thing
Richard M. Stallman's avatar
Richard M. Stallman committed
677 678 679
		      mlist nil
		      alist nil)
	      ;; else we didn't find a match
680 681
	      (setq mlist (cdr mlist))))) ;end of mlist loop
	(setq alist (cdr alist))))	  ;end of alist loop
Richard M. Stallman's avatar
Richard M. Stallman committed
682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698
    rtnvalue))


;; ======================================================================
;; extract mail field information from headers in reply buffer

;; holder variables for bc happiness
(defvar sc-mail-headers-start nil
  "Start of header fields.")
(defvar sc-mail-headers-end nil
  "End of header fields.")
(defvar sc-mail-field-history nil
  "For minibuffer completion on mail field queries.")
(defvar sc-mail-field-modification-history nil
  "For minibuffer completion on mail field modifications.")
(defvar sc-mail-glom-frame
  '((begin                        (setq sc-mail-headers-start (point)))
699
    ("^From "                     (sc-mail-check-from) nil nil)
Richard M. Stallman's avatar
Richard M. Stallman committed
700 701 702 703 704 705 706
    ("^x-attribution:[ \t]+.*$"   (sc-mail-fetch-field t) nil t)
    ("^\\S +:.*$"                 (sc-mail-fetch-field) nil t)
    ("^$"                         (list 'abort '(step . 0)))
    ("^[ \t]+"                    (sc-mail-append-field))
    (sc-mail-warn-if-non-rfc822-p (sc-mail-error-in-mail-field))
    (end                          (setq sc-mail-headers-end (point))))
  "Regi frame for glomming mail header information.")
707
(put 'sc-mail-glom-frame 'risky-local-variable t)
Richard M. Stallman's avatar
Richard M. Stallman committed
708

709
(defvar curline)			; dynamic bondage
Dave Love's avatar
Dave Love committed
710

Richard M. Stallman's avatar
Richard M. Stallman committed
711
;; regi functions
712 713 714 715 716 717 718 719

;; http://lists.gnu.org/archive/html/emacs-devel/2009-02/msg00691.html
;; When rmail replies to a message with full headers visible, the "From "
;; line can be included.
(defun sc-mail-check-from ()
  "Deal with a \"From \" line in the header.
Such a line should only occur at the very start of the headers."
  (and sc-mail-warn-if-non-rfc822-p
Glenn Morris's avatar
Glenn Morris committed
720
       (/= (point) sc-mail-headers-start)
721 722
       (sc-mail-error-in-mail-field)))

Richard M. Stallman's avatar
Richard M. Stallman committed
723 724 725 726 727
(defun sc-mail-fetch-field (&optional attribs-p)
  "Insert a key and value into `sc-mail-info' alist.
If optional ATTRIBS-P is non-nil, the key/value pair is placed in
`sc-attributions' too."
  (if (string-match "^\\(\\S *\\)\\s *:\\s +\\(.*\\)$" curline)
728 729
      (let* ((key (downcase (match-string-no-properties 1 curline)))
	     (val (match-string-no-properties 2 curline))
Richard M. Stallman's avatar
Richard M. Stallman committed
730
	     (keyval (cons key val)))
731
	(push keyval sc-mail-info)
Richard M. Stallman's avatar
Richard M. Stallman committed
732
	(if attribs-p
733
	    (push keyval sc-attributions))))
Richard M. Stallman's avatar
Richard M. Stallman committed
734 735 736 737 738 739
  nil)

(defun sc-mail-append-field ()
  "Append a continuation line onto the last fetched mail field's info."
  (let ((keyval (car sc-mail-info)))
    (if (and keyval (string-match "^\\s *\\(.*\\)$" curline))
740
	(setcdr keyval (concat (cdr keyval) " "
741
			       (match-string-no-properties 1 curline)))))
Richard M. Stallman's avatar
Richard M. Stallman committed
742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759
  nil)

(defun sc-mail-error-in-mail-field ()
  "Issue warning that mail headers don't conform to RFC 822."
  (let* ((len (min (length curline) 10))
	 (ellipsis (if (< len (length curline)) "..." ""))
	 (msg "Mail header \"%s%s\" doesn't conform to RFC 822. skipping..."))
    (message msg (substring curline 0 len) ellipsis))
  (beep)
  (sit-for 2)
  nil)

;; mail header nuking
(defvar sc-mail-last-header-nuked-p nil
  "True if the last header was nuked.")

(defun sc-mail-nuke-line ()
  "Nuke the current mail header line."
760
  (delete-region (line-beginning-position) (line-beginning-position 2))
Richard M. Stallman's avatar
Richard M. Stallman committed
761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783
  '((step . -1)))

(defun sc-mail-nuke-header-line ()
  "Delete current-line and set up for possible continuation."
  (setq sc-mail-last-header-nuked-p t)
  (sc-mail-nuke-line))

(defun sc-mail-nuke-continuation-line ()
  "Delete a continuation line if the last header line was deleted."
  (if sc-mail-last-header-nuked-p
      (sc-mail-nuke-line)))

(defun sc-mail-cleanup-blank-lines ()
  "Leave some blank lines after original mail headers are nuked.
The number of lines left is specified by `sc-blank-lines-after-headers'."
  (if sc-blank-lines-after-headers
      (save-restriction
	(widen)
	(skip-chars-backward " \t\n")
	(forward-line 1)
	(delete-blank-lines)
	(beginning-of-line)
	(if (looking-at "[ \t]*$")
784 785
	    (delete-region (line-beginning-position)
			   (line-beginning-position 2)))
Richard M. Stallman's avatar
Richard M. Stallman committed
786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802
	(insert-char ?\n sc-blank-lines-after-headers)))
  nil)

(defun sc-mail-build-nuke-frame ()
  "Build the regiframe for nuking mail headers."
  (let (every-func entry-func nonentry-func)
    (cond
     ((eq sc-nuke-mail-headers 'all)
      (setq every-func '(progn (forward-line -1) (sc-mail-nuke-line))))
     ((eq sc-nuke-mail-headers 'specified)
      (setq entry-func    '(sc-mail-nuke-header-line)
	    nonentry-func '(setq sc-mail-last-header-nuked-p nil)))
     ((eq sc-nuke-mail-headers 'keep)
      (setq entry-func    '(setq sc-mail-last-header-nuked-p nil)
	    nonentry-func '(sc-mail-nuke-header-line)))
     ;; we never get far enough to interpret a frame if s-n-m-h == 'none
     ((eq sc-nuke-mail-headers 'none))
803
     (t (error "Invalid value for sc-nuke-mail-headers: %s"
804
	       sc-nuke-mail-headers)))	; end-cond
Richard M. Stallman's avatar
Richard M. Stallman committed
805 806 807 808 809 810 811 812
    (append
     (and entry-func
	  (regi-mapcar sc-nuke-mail-header-list entry-func nil t))
     (and nonentry-func (list (list "^\\S +:.*$" nonentry-func)))
     (and (not every-func)
	  '(("^[ \t]+" (sc-mail-nuke-continuation-line))))
     '((begin     (setq sc-mail-last-header-zapped-p nil)))
     '((end       (sc-mail-cleanup-blank-lines)))
813
     (and every-func (list (list 'every every-func))))))
Richard M. Stallman's avatar
Richard M. Stallman committed
814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833

;; mail processing and zapping. this is the top level entry defun to
;; all header processing.
(defun sc-mail-process-headers (start end)
  "Process original mail message's mail headers.
After processing, mail headers may be nuked.  Header information is
stored in `sc-mail-info', and any old information is lost unless an
error occurs."
  (interactive "r")
  (let ((info (copy-alist sc-mail-info))
	(attribs (copy-alist sc-attributions)))
    (setq sc-mail-info nil
	  sc-attributions nil)
    (regi-interpret sc-mail-glom-frame start end)
    (if (null sc-mail-info)
	(progn
	  (message "No mail headers found! Restoring old information.")
	  (setq sc-mail-info info
		sc-attributions attribs))
      (regi-interpret (sc-mail-build-nuke-frame)
834
		      sc-mail-headers-start sc-mail-headers-end))))
Richard M. Stallman's avatar
Richard M. Stallman committed
835 836 837 838 839 840 841


;; let the user change mail field information
(defun sc-mail-field (field)
  "Return the mail header field value associated with FIELD.
If there was no mail header with FIELD as its key, return the value of
`sc-mumble'.  FIELD is case insensitive."
842
  (or (cdr (assoc-string field sc-mail-info 'case-fold)) sc-mumble))
Richard M. Stallman's avatar
Richard M. Stallman committed
843 844 845 846 847 848 849 850 851 852 853

(defun sc-mail-field-query (arg)
  "View the value of a mail field.
With `\\[universal-argument]', prompts for action on mail field.
Action can be one of: View, Modify, Add, or Delete."
  (interactive "P")
  (let* ((alist '(("view" . ?v) ("modify" . ?m) ("add" . ?a) ("delete" . ?d)))
	 (action (if (not arg) ?v (sc-ask alist)))
	 key)
    (if (not action)
	()
854
      (setq key (completing-read
Richard M. Stallman's avatar
Richard M. Stallman committed
855 856 857 858 859 860 861 862 863 864 865 866 867
		 (concat (car (rassq action alist))
			      " information key: ")
		 sc-mail-info nil
		 (if (eq action ?a) nil 'noexit)
		 nil 'sc-mail-field-history))
      (cond
       ((eq action ?v)
	(message "%s: %s" key (cdr (assoc key sc-mail-info))))
       ((eq action ?d)
	(setq sc-mail-info (delq (assoc key sc-mail-info) sc-mail-info)))
       ((eq action ?m)
	(let ((keyval (assoc key sc-mail-info)))
	  ;; first put initial value onto list if not already there
868 869
	  (if (not (member (cdr keyval)
			   sc-mail-field-modification-history))
Richard M. Stallman's avatar
Richard M. Stallman committed
870 871
	      (setq sc-mail-field-modification-history
		    (cons (cdr keyval) sc-mail-field-modification-history)))
872
	  (setcdr keyval (read-string
Richard M. Stallman's avatar
Richard M. Stallman committed
873 874 875
			  (concat key ": ") (cdr keyval)
			  'sc-mail-field-modification-history))))
       ((eq action ?a)
876
	(push (cons key (read-string (concat key ": "))) sc-mail-info))))))
Richard M. Stallman's avatar
Richard M. Stallman committed
877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892


;; ======================================================================
;; attributions

(defvar sc-attribution-confirmation-history nil
  "History for confirmation of attribution strings.")
(defvar sc-citation-confirmation-history nil
  "History for confirmation of attribution prefixes.")

(defun sc-attribs-%@-addresses (from &optional delim)
  "Extract the author's email terminus from email address FROM.
Match addresses of the style ``name%[stuff].'' when called with DELIM
of \"%\" and addresses of the style ``[stuff]name@[stuff]'' when
called with DELIM \"@\".  If DELIM is nil or not provided, matches
addresses of the style ``name''."
893
  (and (string-match (concat "[-[:alnum:]_.]+" delim) from 0)
Richard M. Stallman's avatar
Richard M. Stallman committed
894 895 896 897 898 899 900 901
       (substring from
		  (match-beginning 0)
		  (- (match-end 0) (if (null delim) 0 1)))))

(defun sc-attribs-!-addresses (from)
  "Extract the author's email terminus from email address FROM.
Match addresses of the style ``[stuff]![stuff]...!name[stuff].''"
  (let ((eos (length from))
902
	(mstart (string-match "![-[:alnum:]_.]+\\([^-![:alnum:]_.]\\|$\\)"
Richard M. Stallman's avatar
Richard M. Stallman committed
903 904 905
			      from 0))
	(mend (match-end 0)))
    (and mstart
906
	 (substring from (1+ mstart) (- mend (if (= mend eos) 0 1))))))
Richard M. Stallman's avatar
Richard M. Stallman committed
907 908 909 910 911

(defun sc-attribs-<>-addresses (from)
  "Extract the author's email terminus from email address FROM.
Match addresses of the style ``<name[stuff]>.''"
  (and (string-match "<\\(.*\\)>" from)
912
       (match-string 1 from)))
Richard M. Stallman's avatar
Richard M. Stallman committed
913 914 915 916 917

(defun sc-get-address (from author)
  "Get the full email address path from FROM.
AUTHOR is the author's name (which is removed from the address)."
  (let ((eos (length from)))
918 919
    (if (string-match (concat "\\`\"?" (regexp-quote author)
			      "\"?\\s +") from 0)
Richard M. Stallman's avatar
Richard M. Stallman committed
920 921 922 923 924
	(let ((address (substring from (match-end 0) eos)))
	  (if (and (= (aref address 0) ?<)
		   (= (aref address (1- (length address))) ?>))
	      (substring address 1 (1- (length address)))
	    address))
Dave Love's avatar
Dave Love committed
925
      (if (string-match "[-[:alnum:]!@%._]+" from 0)
926
	  (match-string 0 from)
927
	""))))
Richard M. Stallman's avatar
Richard M. Stallman committed
928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946

(defun sc-attribs-emailname (from)
  "Get the email terminus name from FROM."
  (or
   (sc-attribs-%@-addresses from "%")
   (sc-attribs-%@-addresses from "@")
   (sc-attribs-!-addresses  from)
   (sc-attribs-<>-addresses from)
   (sc-attribs-%@-addresses from)
   (substring from 0 10)))

(defun sc-name-substring (string start end extend)
  "Extract the specified substring of STRING from START to END.
EXTEND is the number of characters on each side to extend the
substring."
  (and start
       (let ((sos (+ start extend))
	     (eos (- end extend)))
	 (substring string sos
947
		    (or (string-match sc-titlecue-regexp string sos) eos)))))
Richard M. Stallman's avatar
Richard M. Stallman committed
948 949 950 951

(defun sc-attribs-extract-namestring (from)
  "Extract the name string from FROM.
This should be the author's full name minus an optional title."
952
  ;; FIXME: we probably should use mail-extract-address-components.
Richard M. Stallman's avatar
Richard M. Stallman committed
953 954
  (let ((namestring
	 (or
955 956 957
	  ;; If there is a <...> in the name,
	  ;; treat everything before that as the full name.
	  ;; Even if it contains parens, use the whole thing.
958
	  ;; On the other hand, we do look for quotes in the usual way.
959
	  (and (string-match " *<.*>" from 0)
960 961 962 963 964 965
	       (let ((before-angles
		      (sc-name-substring from 0 (match-beginning 0) 0)))
		 (if (string-match "\".*\"" before-angles 0)
		     (sc-name-substring
		      before-angles (match-beginning 0) (match-end 0) 1)
		   before-angles)))
Richard M. Stallman's avatar
Richard M. Stallman committed
966 967 968 969 970
	  (sc-name-substring
	   from (string-match "(.*)" from 0) (match-end 0) 1)
	  (sc-name-substring
	   from (string-match "\".*\"" from 0) (match-end 0) 1)
	  (sc-name-substring
Dave Love's avatar
Dave Love committed
971
	   from (string-match "\\([-.[:alnum:]_]+\\s +\\)+<" from 0)
Richard M. Stallman's avatar
Richard M. Stallman committed
972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987
	   (match-end 1) 0)
	  (sc-attribs-emailname from))))
    ;; strip off any leading or trailing whitespace
    (if namestring
	(let ((bos 0)
	      (eos (1- (length namestring))))
	  (while (and (<= bos eos)
		      (memq (aref namestring bos) '(32 ?\t)))
	    (setq bos (1+ bos)))
	  (while (and (> eos bos)
		      (memq (aref namestring eos) '(32 ?\t)))
	    (setq eos (1- eos)))
	  (substring namestring bos (1+ eos))))))

(defun sc-attribs-chop-namestring (namestring)
  "Convert NAMESTRING to a list of names.
988
example: (sc-attribs-chop-namestring \"John Xavier Doe\")
Richard M. Stallman's avatar
Richard M. Stallman committed
989 990
         => (\"John\" \"Xavier\" \"Doe\")"
  (if (string-match "\\([ \t]*\\)\\([^ \t._]+\\)\\([ \t]*\\)" namestring)
991
      (cons (match-string 2 namestring)
992
	    (sc-attribs-chop-namestring (substring namestring (match-end 3))))))
Richard M. Stallman's avatar
Richard M. Stallman committed
993 994 995 996

(defun sc-attribs-strip-initials (namelist)
  "Extract the author's initials from the NAMELIST."
  (mapconcat
997 998 999
   (lambda (name)
     (if (< 0 (length name))
	 (substring name 0 1)))
Richard M. Stallman's avatar
Richard M. Stallman committed
1000 1001 1002 1003 1004 1005 1006
   namelist ""))

(defun sc-guess-attribution (&optional string)
  "Guess attribution string on current line.
If attribution cannot be guessed, nil is returned.  Optional STRING if
supplied, is used instead of the line point is on in the current buffer."
  (let ((start 0)
1007 1008
	(string (or string (buffer-substring (line-beginning-position)
					     (line-end-position))))
Richard M. Stallman's avatar
Richard M. Stallman committed
1009 1010 1011 1012 1013
	attribution)
    (and
     (= start (or (string-match sc-citation-leader-regexp string start) -1))
     (setq start (match-end 0))
     (= start (or (string-match sc-citation-root-regexp string start) 1))
1014
     (setq attribution (match-string 0 string)
Richard M. Stallman's avatar
Richard M. Stallman committed
1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025
	   start (match-end 0))
     (= start (or (string-match sc-citation-delimiter-regexp string start) -1))
     (setq start (match-end 0))
     (= start (or (string-match sc-citation-separator-regexp string start) -1))
     attribution)))

(defun sc-attribs-filter-namelist (namelist)
  "Filter out noise in NAMELIST according to `sc-name-filter-alist'."
  (let ((elements (length namelist))
	(position -1)
	keepers filtered-list)
1026
    (mapc
1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044
     (lambda (name)
       (setq position (1+ position))
       (let ((keep-p t))
	 (mapc
	  (function
	   (lambda (filter)
	     (let ((regexp (car filter))
		   (pos (cdr filter)))
	       (if (and (string-match regexp name)
			(or (and (numberp pos)
				 (= pos position))
			    (and (eq pos 'last)
				 (= position (1- elements)))
			    (eq pos 'any)))
		   (setq keep-p nil)))))
	  sc-name-filter-alist)
	 (if keep-p
	     (setq keepers (cons position keepers)))))
Richard M. Stallman's avatar
Richard M. Stallman committed
1045
     namelist)
1046
    (mapc
1047 1048
     (lambda (position)
       (setq filtered-list (cons (nth position namelist) filtered-list)))
Richard M. Stallman's avatar
Richard M. Stallman committed
1049 1050 1051 1052 1053 1054 1055 1056
     keepers)
    filtered-list))

(defun sc-attribs-chop-address (from)
  "Extract attribution information from FROM.
This populates the `sc-attributions' with the list of possible attributions."
  (if (and (stringp from)
	   (< 0 (length from)))
1057
      (let* ((sc-mumble "")
Richard M. Stallman's avatar
Richard M. Stallman committed
1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068
	     (namestring (sc-attribs-extract-namestring from))
	     (namelist   (sc-attribs-filter-namelist
			  (sc-attribs-chop-namestring namestring)))
	     (revnames   (reverse (cdr namelist)))
	     (firstname  (car namelist))
	     (midnames   (reverse (cdr revnames)))
	     (lastname   (car revnames))
	     (initials   (sc-attribs-strip-initials namelist))
	     (emailname  (sc-attribs-emailname from))
	     (n 1)
	     author middlenames)