1 ;;; supercite.el --- minor mode for citing mail and news replies
3 ;; Author: 1993 Barry A. Warsaw, Century Computing, Inc. <bwarsaw@python.org>
4 ;; Maintainer: The XEmacs Development Team <xemacs-beta@xemacs.org>
5 ;; Created: February 1993
7 ;; Last Modified: Fri Aug 4 15:01:46 CEST 2000
8 ;; Keywords: citation attribution mail news article reply followup
10 ;; supercite.el revision: 3.55-x
12 ;; Copyright (C) 1993 Barry A. Warsaw
14 ;; This file is part of XEmacs.
16 ;; XEmacs is free software; you can redistribute it and/or modify it
17 ;; under the terms of the GNU General Public License as published by
18 ;; the Free Software Foundation; either version 2, or (at your option)
21 ;; XEmacs is distributed in the hope that it will be useful, but
22 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
23 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
24 ;; General Public License for more details.
26 ;; You should have received a copy of the GNU General Public License
27 ;; along with XEmacs; see the file COPYING. If not, write to the
28 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
29 ;; Boston, MA 02111-1307, USA.
31 ;;; Synched up with: Not synched.
34 ;; supercite|Barry A. Warsaw|supercite-help@python.org
35 ;; |Mail and news reply citation package
36 ;; |1993/09/22 18:58:46|3.1|
38 ;; njsf 2005/10/28: Added customize for extract address components
39 ;; sb 1997/May/07: Add autoloads
40 ;; sb 1997/Apr/02: Added attribution function sc-header-author-email-writes
41 ;; which gives attribution in the form -
42 ;; Steve Baur <steve@xemacs.org> writes:
44 ;; Modified by Bob Weiner <weiner@infodock.com>, 8/5/95, for use in InfoDock.
45 ;; Added sc-rewrite-address-function and sc-rewrite-region-function
46 ;; variables. See their doc strings.
47 ;; Modified these functions to handle ugly Motorola X.400 addresses.
48 ;; sc-attribs-%@-addresses, sc-attribs-chop-namestring, sc-get-address,
49 ;; sc-mail-process-headers.
51 ;; Modified by Bob Weiner <weiner@infodock.com>, 3/1/97, for use in InfoDock.
52 ;; Added removal of [bracketed] terms from attributed names via
53 ;; `sc-name-filter-alist'.
60 ;; start user configuration variables
61 ;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
63 (defgroup supercite nil
69 (defgroup supercite-frames nil
70 "Supercite (regi) frames"
74 (defgroup supercite-attr nil
75 "Supercite attributions"
79 (defgroup supercite-cite nil
84 (defgroup supercite-hooks nil
85 "Hooking into supercite"
89 (defcustom sc-rewrite-address-function nil
90 "*Function to rewrite addresses prior to being parsed by Supercite.
91 It should take as its only parameter an email address."
95 (defcustom sc-rewrite-region-function nil
96 "*Function to rewrite addresses prior to being parsed by Supercite."
100 (defcustom sc-extract-address-components 'mail-extract-address-components
101 "*Function for extracting address components from a From header.
102 One pre-defined function exist: `mail-extract-address-components'."
104 :type '(radio (function-item mail-extract-address-components)
105 (function :tag "Other")))
107 (defcustom sc-auto-fill-region-p t
108 "*If non-nil, automatically fill each paragraph after it has been cited."
112 (defcustom sc-blank-lines-after-headers 1
113 "*Number of blank lines to leave after mail headers have been nuked.
114 Set to nil, to use whatever blank lines happen to occur naturally."
115 :type '(choice (const :tag "leave" nil)
119 (defcustom sc-citation-leader " "
120 "*String comprising first part of a citation."
122 :group 'supercite-cite)
124 (defcustom sc-citation-delimiter ">"
125 "*String comprising third part of a citation.
126 This string is used in both nested and non-nested citations."
128 :group 'supercite-cite)
130 (defcustom sc-citation-separator " "
131 "*String comprising fourth and last part of a citation."
133 :group 'supercite-cite)
135 (defcustom sc-citation-leader-regexp "[ \t]*"
136 "*Regexp describing citation leader for a cited line.
137 This should NOT have a leading `^' character."
139 :group 'supercite-cite)
141 ;; Nemacs and Mule users note: please see the texinfo manual for
142 ;; suggestions on setting these variables.
143 (defcustom sc-citation-root-regexp "[-._a-zA-Z0-9]*"
144 "*Regexp describing variable root part of a citation for a cited line.
145 This should NOT have a leading `^' character. See also
146 `sc-citation-nonnested-root-regexp'."
148 :group 'supercite-cite)
150 (defcustom sc-citation-nonnested-root-regexp "[-._a-zA-Z0-9]+"
151 "*Regexp describing the variable root part of a nested citation.
152 This should NOT have a leading `^' character. This variable is
153 related to `sc-citation-root-regexp' but where as that varariable
154 describes both nested and non-nested citation roots, this variable
155 describes only nested citation roots."
157 :group 'supercite-cite)
159 (defcustom sc-citation-delimiter-regexp "[>]+"
160 "*Regexp describing citation delimiter for a cited line.
161 This should NOT have a leading `^' character."
163 :group 'supercite-cite)
165 (defcustom sc-citation-separator-regexp "[ \t]*"
166 "*Regexp describing citation separator for a cited line.
167 This should NOT have a leading `^' character."
169 :group 'supercite-cite)
171 (defcustom sc-cite-blank-lines-p nil
172 "*If non-nil, put a citation on blank lines."
174 :group 'supercite-cite)
176 (defcustom sc-cite-frame-alist '()
177 "*Alist for frame selection during citing.
178 Each element of this list has the following form:
180 (INFOKEY ((REGEXP . FRAME)
184 Where INFOKEY is a key for `sc-mail-field', REGEXP is a regular
185 expression to match against the INFOKEY's value. FRAME is a citation
186 frame, or a variable containing a citation frame."
187 :type '(repeat (list symbol (repeat (cons regexp
188 (choice (repeat (repeat sexp))
190 :group 'supercite-frames)
192 (defcustom sc-uncite-frame-alist '()
193 "*Alist for frame selection during unciting.
194 See the variable `sc-cite-frame-alist' for details."
195 :type '(repeat (list symbol (repeat (cons regexp
196 (choice (repeat (repeat sexp))
198 :group 'supercite-frames)
200 (defcustom sc-recite-frame-alist '()
201 "*Alist for frame selection during reciting.
202 See the variable `sc-cite-frame-alist' for details."
203 :type '(repeat (list symbol (repeat (cons regexp
204 (choice (repeat (repeat sexp))
206 :group 'supercite-frames)
208 (defcustom sc-default-cite-frame
209 '(;; initialize fill state and temporary variables when entering
210 ;; frame. this makes things run much faster
212 (sc-fill-if-different)
213 (setq sc-tmp-nested-regexp (sc-cite-regexp "")
214 sc-tmp-nonnested-regexp (sc-cite-regexp)
219 (sc-cite-regexp sc-citation-nonnested-root-regexp))
221 ;; blank lines mean paragraph separators, so fill the last cited
222 ;; paragraph, unless sc-cite-blank-lines-p is non-nil, in which
223 ;; case we treat blank lines just like any other line.
224 ("^[ \t]*$" (if sc-cite-blank-lines-p
226 (sc-fill-if-different "")))
227 ;; do nothing if looking at a reference tag. make sure that the
228 ;; tag string isn't the empty string since this will match every
229 ;; line. it cannot be nil.
230 (sc-reference-tag-string (if (string= sc-reference-tag-string "")
233 ;; this regexp catches nested citations in which the author cited
234 ;; a non-nested citation with a dumb citer.
235 (sc-tmp-dumb-regexp (sc-cite-coerce-dumb-citer))
236 ;; if we are looking at a nested citation then add a citation level
237 (sc-tmp-nested-regexp (sc-add-citation-level))
238 ;; if we're looking at a non-nested citation, coerce it to our style
239 (sc-tmp-nonnested-regexp (sc-cite-coerce-cited-line))
240 ;; we must be looking at an uncited line. if we are in nested
241 ;; citations, just add a citation level
242 (sc-nested-citation-p (sc-add-citation-level))
243 ;; we're looking at an uncited line and we are in non-nested
244 ;; citations, so cite it with a non-nested citation
246 ;; be sure when we're done that we fill the last cited paragraph.
247 (end (sc-fill-if-different ""))
249 "*Default REGI frame for citing a region."
250 :type '(repeat (repeat sexp))
251 :group 'supercite-frames)
253 (defcustom sc-default-uncite-frame
254 '(;; do nothing on a blank line
256 ;; if the line is cited, uncite it
257 ((sc-cite-regexp) (sc-uncite-line))
259 "*Default REGI frame for unciting a region."
260 :type '(repeat (repeat sexp))
261 :group 'supercite-frames)
263 (defcustom sc-default-recite-frame
264 '(;; initialize fill state when entering frame
265 (begin (sc-fill-if-different))
266 ;; do nothing on a blank line
268 ;; if we're looking at a cited line, recite it
269 ((sc-cite-regexp) (sc-recite-line (sc-cite-regexp)))
270 ;; otherwise, the line is uncited, so just cite it
272 ;; be sure when we're done that we fill the last cited paragraph.
273 (end (sc-fill-if-different ""))
275 "*Default REGI frame for reciting a region."
276 :type '(repeat (repeat sexp))
277 :group 'supercite-frames)
279 (defcustom sc-cite-region-limit t
280 "*This variable controls automatic citation of yanked text.
283 non-nil -- cite the entire region, regardless of its size
284 nil -- do not cite the region at all
285 <integer> -- a number indicating the threshold for citation. When
286 the number of lines in the region is greater than this
287 value, a warning message will be printed and the region
288 will not be cited. Lines in region are counted with
291 The gathering of attribution information is not affected by the value
292 of this variable. The number of lines in the region is calculated
293 *after* all mail headers are removed. This variable is only consulted
294 during the initial citing via `sc-cite-original'."
295 :type '(choice (const :tag "always cite" t)
296 (const :tag "do not cite" nil)
297 (integer :tag "citation threshold"))
298 :group 'supercite-cite)
300 (defcustom sc-confirm-always-p t
301 "*If non-nil, always confirm attribution string before citing text body."
303 :group 'supercite-attr)
305 (defcustom sc-default-attribution "Anon"
306 "*String used when author's attribution cannot be determined."
308 :group 'supercite-attr)
309 (defcustom sc-default-author-name "Anonymous"
310 "*String used when author's name cannot be determined."
312 :group 'supercite-attr)
313 (defcustom sc-downcase-p nil
314 "*Non-nil means downcase the attribution and citation strings."
316 :group 'supercite-attr
317 :group 'supercite-cite)
318 (defcustom sc-electric-circular-p t
319 "*If non-nil, treat electric references as circular."
321 :group 'supercite-attr)
323 (defcustom sc-electric-mode-hook nil
324 "*Hook for `sc-electric-mode' electric references mode."
326 :group 'supercite-hooks)
327 (defcustom sc-electric-references-p nil
328 "*Use electric references if non-nil."
332 (defcustom sc-fixup-whitespace-p nil
333 "*If non-nil, delete all leading white space before citing."
337 (defcustom sc-load-hook nil
338 "*Hook which gets run once after Supercite loads."
340 :group 'supercite-hooks)
341 (defcustom sc-pre-hook nil
342 "*Hook which gets run before each invocation of `sc-cite-original'."
344 :group 'supercite-hooks)
345 (defcustom sc-post-hook nil
346 "*Hook which gets run after each invocation of `sc-cite-original'."
348 :group 'supercite-hooks)
350 (defcustom sc-mail-warn-if-non-rfc822-p t
351 "*Warn if mail headers don't conform to RFC822."
353 :group 'supercite-attr)
354 (defcustom sc-mumble ""
355 "*Value returned by `sc-mail-field' if field isn't in mail headers."
357 :group 'supercite-attr)
359 (defcustom sc-name-filter-alist
361 ;; This first item removes any [bracketed] multi-word items in names.
362 ;; Each word is already split into a separate string when this filter is
363 ;; applied, hence the complexity of the expression.
364 ("\\[.*\\]\\|\\[[^\]]*\\|[^\[]*\\]" . any)
365 ("^\\(Mr\\|Mrs\\|Ms\\|Dr\\)[.]?$" . 0)
366 ("^\\(Jr\\|Sr\\)[.]?$" . last)
369 "*Name list components which are filtered out as noise.
370 This variable contains an association list where each element is of
371 the form: (REGEXP . POSITION).
373 REGEXP is a regular expression which matches the name list component.
374 Match is performed using `string-match'. POSITION is the position in
375 the name list which can match the regular expression, starting at zero
376 for the first element. Use `last' to match the last element in the
377 list and `any' to match all elements."
378 :type '(repeat (cons regexp (choice (const last) (const any)
379 (integer :tag "position"))))
380 :group 'supercite-attr)
382 (defcustom sc-nested-citation-p nil
383 "*Controls whether to use nested or non-nested citation style.
384 Non-nil uses nested citations, nil uses non-nested citations."
388 (defcustom sc-nuke-mail-headers 'all
389 "*Controls mail header nuking.
390 Used in conjunction with `sc-nuke-mail-header-list'. Legal values are:
392 `all' -- nuke all mail headers
393 `none' -- don't nuke any mail headers
394 `specified' -- nuke headers specified in `sc-nuke-mail-header-list'
395 `keep' -- keep headers specified in `sc-nuke-mail-header-list'"
396 :type '(choice (const all) (const none)
397 (const specified) (const keep))
400 (defcustom sc-nuke-mail-header-list nil
401 "*List of mail header regexps to remove or keep in body of reply.
402 This list contains regular expressions describing the mail headers to
403 keep or nuke, depending on the value of `sc-nuke-mail-headers'."
404 :type '(repeat regexp)
407 (defcustom sc-preferred-attribution-list
408 '("sc-lastchoice" "x-attribution" "firstname" "initials" "lastname")
409 "*Specifies what to use as the attribution string.
410 Supercite creates a list of possible attributions when it scans the
411 mail headers from the original message. Each attribution choice is
412 associated with a key in an attribution alist. Supercite tries to
413 pick a \"preferred\" attribution by matching the attribution alist
414 keys against the elements in `sc-preferred-attribution-list' in order.
415 The first non-empty string value found is used as the preferred
418 Note that Supercite now honors the X-Attribution: mail field. If
419 present in the original message, the value of this field should always
420 be used to select the most preferred attribution since it reflects how
421 the original author would like to be distinguished. It should be
422 considered bad taste to put any attribution preference key before
423 \"x-attribution\" in this list, except perhaps for \"sc-lastchoice\"
426 Supercite remembers the last attribution used when reciting an already
427 cited paragraph. This attribution will always be saved with the
428 \"sc-lastchoice\" key, which can be used in this list. Note that the
429 last choice is always reset after every call of `sc-cite-original'.
431 Barring error conditions, the following preferences are always present
432 in the attribution alist:
434 \"emailname\" -- email terminus name
435 \"initials\" -- initials of author
436 \"firstname\" -- first name of author
437 \"lastname\" -- last name of author
438 \"middlename-1\" -- first middle name of author
439 \"middlename-2\" -- second middle name of author
442 Middle name indexes can be any positive integer greater than 0,
443 although it is unlikely that many authors will supply more than one
444 middle name, if that many. The string of all middle names is
445 associated with the key \"middlenames\"."
446 :type '(repeat string)
447 :group 'supercite-attr)
449 (defcustom sc-attrib-selection-list nil
450 "*An alist for selecting preferred attribution based on mail headers.
451 Each element of this list has the following form:
453 (INFOKEY ((REGEXP . ATTRIBUTION)
454 (REGEXP . ATTRIBUTION)
457 Where INFOKEY is a key for `sc-mail-field', REGEXP is a regular
458 expression to match against the INFOKEY's value. ATTRIBUTION can be a
459 string or a list. If its a string, then it is the attribution that is
460 selected by `sc-select-attribution'. If it is a list, it is `eval'd
461 and the return value must be a string, which is used as the selected
462 attribution. Note that the variable `sc-preferred-attribution-list'
463 must contain an element of the string \"sc-consult\" for this variable
464 to be consulted during attribution selection."
465 :type '(repeat (group (string :tag "Infokey")
466 (repeat :format "\n%v%i\n"
468 (regexp :tag " Regexp")
469 (choice :tag "Attribution"
470 :format "%{%t%}: %[choice%] %v"
472 :group 'supercite-attr)
474 (defcustom sc-attribs-preselect-hook nil
475 "*Hook to run before selecting an attribution."
477 :group 'supercite-attr
478 :group 'supercite-hooks)
479 (defcustom sc-attribs-postselect-hook nil
480 "*Hook to run after selecting an attribution, but before confirmation."
482 :group 'supercite-attr
483 :group 'supercite-hooks)
485 (defcustom sc-pre-cite-hook nil
486 "*Hook to run before citing a region of text."
488 :group 'supercite-cite
489 :group 'supercite-hooks)
490 (defcustom sc-pre-uncite-hook nil
491 "*Hook to run before unciting a region of text."
493 :group 'supercite-cite
494 :group 'supercite-hooks)
495 (defcustom sc-pre-recite-hook nil
496 "*Hook to run before reciting a region of text."
498 :group 'supercite-cite
499 :group 'supercite-hooks)
501 (defcustom sc-preferred-header-style 4
502 "*Index into `sc-rewrite-header-list' specifying preferred header style.
503 Index zero accesses the first function in the list."
507 (defcustom sc-reference-tag-string ">>>>> "
508 "*String used at the beginning of built-in reference headers."
512 (defcustom sc-rewrite-header-list
515 (sc-header-inarticle-writes)
516 (sc-header-regarding-adds)
517 (sc-header-attributed-writes)
518 (sc-header-author-writes)
520 (sc-no-blank-line-or-header)
521 (sc-header-author-email-writes)
523 "*List of reference header rewrite functions.
524 The variable `sc-preferred-header-style' controls which function in
525 this list is chosen for automatic reference header insertions.
526 Electric reference mode will cycle through this list of functions."
530 (defcustom sc-titlecue-regexp "\\s +-+\\s +"
531 "*Regular expression describing the separator between names and titles.
532 Set to nil to treat entire field as a name."
533 :type '(choice (const :tag "entire field as name" nil)
535 :group 'supercite-attr)
537 (defcustom sc-use-only-preference-p nil
538 "*Controls what happens when the preferred attribution cannot be found.
539 If non-nil, then `sc-default-attribution' will be used. If nil, then
540 some secondary scheme will be employed to find a suitable attribution
543 :group 'supercite-attr)
545 ;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
546 ;; end user configuration variables
548 (defconst sc-version "3.1"
549 "Supercite version number.")
550 (defconst sc-help-address "xemacs-beta@xemacs.org"
551 "Address accepting submissions of bug reports.")
553 (defvar sc-mail-info nil
554 "Alist of mail header information gleaned from reply buffer.")
555 (defvar sc-attributions nil
556 "Alist of attributions for use when citing.")
558 (defconst sc-emacs-features
562 (string= (substring emacs-version 0 2) "19")
563 (string= (substring emacs-version 0 2) "20"))
565 (if (string-match "XEmacs" emacs-version)
566 (setq flavor 'Lucid))
568 (list version flavor))
569 "A list describing what version of Emacs we're running on.
572 All GNU18's: (v18 GNU)
574 Lucid19.x : (v19 Lucid)")
577 (defvar sc-tmp-nested-regexp nil
578 "Temporary regepx describing nested citations.")
579 (defvar sc-tmp-nonnested-regexp nil
580 "Temporary regexp describing non-nested citations.")
581 (defvar sc-tmp-dumb-regexp nil
582 "Temp regexp describing non-nested citation cited with a nesting citer.")
584 (defvar sc-minor-mode nil
585 "Supercite minor mode on flag.")
586 (defvar sc-mode-string " SC"
587 "Supercite minor mode string.")
589 (make-variable-buffer-local 'sc-mail-info)
590 (make-variable-buffer-local 'sc-attributions)
591 (make-variable-buffer-local 'sc-minor-mode)
594 ;; ======================================================================
597 (defvar sc-mode-map-prefix "\C-c\C-p"
598 "*Key binding to install Supercite keymap.
599 If this is nil, Supercite keymap is not installed.")
601 (defvar sc-T-keymap ()
602 "Keymap for sub-keymap of setting and toggling functions.")
605 (setq sc-T-keymap (make-sparse-keymap))
606 (define-key sc-T-keymap "a" 'sc-S-preferred-attribution-list)
607 (define-key sc-T-keymap "b" 'sc-T-mail-nuke-blank-lines)
608 (define-key sc-T-keymap "c" 'sc-T-confirm-always)
609 (define-key sc-T-keymap "d" 'sc-T-downcase)
610 (define-key sc-T-keymap "e" 'sc-T-electric-references)
611 (define-key sc-T-keymap "f" 'sc-T-auto-fill-region)
612 (define-key sc-T-keymap "h" 'sc-T-describe)
613 (define-key sc-T-keymap "l" 'sc-S-cite-region-limit)
614 (define-key sc-T-keymap "n" 'sc-S-mail-nuke-mail-headers)
615 (define-key sc-T-keymap "N" 'sc-S-mail-header-nuke-list)
616 (define-key sc-T-keymap "o" 'sc-T-electric-circular)
617 (define-key sc-T-keymap "p" 'sc-S-preferred-header-style)
618 (define-key sc-T-keymap "s" 'sc-T-nested-citation)
619 (define-key sc-T-keymap "u" 'sc-T-use-only-preferences)
620 (define-key sc-T-keymap "w" 'sc-T-fixup-whitespace)
621 (define-key sc-T-keymap "?" 'sc-T-describe)
624 (defvar sc-mode-map ()
625 "Keymap for Supercite quasi-mode.")
628 (setq sc-mode-map (make-sparse-keymap))
629 (define-key sc-mode-map "c" 'sc-cite-region)
630 (define-key sc-mode-map "f" 'sc-mail-field-query)
631 (define-key sc-mode-map "g" 'sc-mail-process-headers)
632 (define-key sc-mode-map "h" 'sc-describe)
633 (define-key sc-mode-map "i" 'sc-insert-citation)
634 (define-key sc-mode-map "o" 'sc-open-line)
635 (define-key sc-mode-map "r" 'sc-recite-region)
636 (define-key sc-mode-map "\C-p" 'sc-raw-mode-toggle)
637 (define-key sc-mode-map "u" 'sc-uncite-region)
638 (define-key sc-mode-map "v" 'sc-version)
639 (define-key sc-mode-map "w" 'sc-insert-reference)
640 (define-key sc-mode-map "\C-t" sc-T-keymap)
641 (define-key sc-mode-map "\C-b" 'sc-submit-bug-report)
642 (define-key sc-mode-map "?" 'sc-describe)
645 (defvar sc-electric-mode-map ()
646 "Keymap for `sc-electric-mode' electric references mode.")
647 (if sc-electric-mode-map
649 (setq sc-electric-mode-map (make-sparse-keymap))
650 (define-key sc-electric-mode-map "p" 'sc-eref-prev)
651 (define-key sc-electric-mode-map "n" 'sc-eref-next)
652 (define-key sc-electric-mode-map "s" 'sc-eref-setn)
653 (define-key sc-electric-mode-map "j" 'sc-eref-jump)
654 (define-key sc-electric-mode-map "x" 'sc-eref-abort)
655 (define-key sc-electric-mode-map "q" 'sc-eref-abort)
656 (define-key sc-electric-mode-map "\r" 'sc-eref-exit)
657 (define-key sc-electric-mode-map "\n" 'sc-eref-exit)
658 (define-key sc-electric-mode-map "g" 'sc-eref-goto)
659 (define-key sc-electric-mode-map "?" 'describe-mode)
660 (define-key sc-electric-mode-map "\C-h" 'describe-mode)
663 (defvar sc-minibuffer-local-completion-map nil
664 "Keymap for minibuffer confirmation of attribution strings.")
665 (if sc-minibuffer-local-completion-map
667 (setq sc-minibuffer-local-completion-map
668 (copy-keymap minibuffer-local-completion-map))
669 (define-key sc-minibuffer-local-completion-map "\C-t" 'sc-toggle-fn)
670 (define-key sc-minibuffer-local-completion-map " " 'self-insert-command))
672 (defvar sc-minibuffer-local-map nil
673 "Keymap for minibuffer confirmation of attribution strings.")
674 (if sc-minibuffer-local-map
676 (setq sc-minibuffer-local-map (copy-keymap minibuffer-local-map))
677 (define-key sc-minibuffer-local-map "\C-t" 'sc-toggle-fn))
680 ;; ======================================================================
683 (defun sc-completing-read (prompt table &optional predicate require-match
684 initial-contents history)
685 "Compatibility between Emacs 18 and 19 `completing-read'.
686 In version 18, the HISTORY argument is ignored."
687 (if (memq 'v19 sc-emacs-features)
688 (funcall 'completing-read prompt table predicate require-match
689 initial-contents history)
690 (funcall 'completing-read prompt table predicate require-match
691 (or (car-safe initial-contents)
694 (defun sc-read-string (prompt &optional initial-contents history)
695 "Compatibility between Emacs 18 and 19 `read-string'.
696 In version 18, the HISTORY argument is ignored."
697 (if (memq 'v19 sc-emacs-features)
698 (funcall 'read-string prompt initial-contents history)
699 (funcall 'read-string prompt initial-contents)))
701 (defun sc-submatch (matchnum &optional string)
702 "Returns `match-beginning' and `match-end' sub-expression for MATCHNUM.
703 If optional STRING is provided, take sub-expression using `substring'
704 of argument, otherwise use `buffer-substring' on current buffer. Note
705 that `match-data' must have already been generated and no error
706 checking is performed by this function."
708 (substring string (match-beginning matchnum) (match-end matchnum))
709 (buffer-substring (match-beginning matchnum) (match-end matchnum))))
711 (defun sc-member (elt list)
712 "Like `memq', but uses `equal' instead of `eq'.
713 Emacs19 has a builtin function `member' which does exactly this."
714 (catch 'elt-is-member
716 (if (equal elt (car list))
717 (throw 'elt-is-member list))
718 (setq list (cdr list)))))
719 (and (memq 'v19 sc-emacs-features)
720 (fset 'sc-member 'member))
722 (defun sc-ask (alist)
723 "Ask a question in the minibuffer requiring a single character answer.
724 This function is kind of an extension of `y-or-n-p' where a single
725 letter is used to answer a question. Question is formed from ALIST
726 which has members of the form: (WORD . LETTER). WORD is the long
727 word form, while LETTER is the letter for selecting that answer. The
728 selected letter is returned, or nil if the question was not answered.
729 Note that WORD is a string and LETTER is a character. All LETTERs in
730 the list should be unique."
731 (let* ((prompt (concat
732 (mapconcat (function (lambda (elt) (car elt))) alist ", ")
736 (lambda (elt) (char-to-string (cdr elt)))) alist "/")
740 (if (memq 'Lucid sc-emacs-features)
744 (if (let ((cursor-in-echo-area t)
747 ;; lets be good neighbors and be compatible with all emacsen
749 ((memq 'v18 sc-emacs-features)
750 (setq event (read-char)))
751 ((memq 'Lucid sc-emacs-features)
752 (next-command-event event))
754 (setq event (read-event))))
755 (prog1 quit-flag (setq quit-flag nil)))
757 (message "%s%s" p (single-key-description event))
758 (and (memq 'Lucid sc-emacs-features)
759 (deallocate-event event))
763 (if (memq 'Lucid sc-emacs-features)
764 (let* ((key (and (key-press-event-p event) (event-key event)))
765 (char (and key (event-to-character event))))
769 (if char (setq char (downcase char)))
771 ((setq elt (rassq char alist))
772 (message "%s%s" p (car elt))
774 ((and (memq 'Lucid sc-emacs-features)
775 (button-release-event-p event)) ; ignore them
778 (message "%s%s" p (single-key-description event))
779 (if (memq 'Lucid sc-emacs-features)
784 (setq p (concat "Try again. " prompt)))))))
785 (and (memq 'Lucid sc-emacs-features)
786 (deallocate-event event))
789 (defun sc-scan-info-alist (alist)
790 "Find a match in the info alist that matches a regexp in ALIST."
794 (let* ((elem (car alist))
796 (infoval (sc-mail-field infokey))
797 (mlist (car (cdr elem))))
799 (let* ((ml-elem (car mlist))
800 (regexp (car ml-elem))
801 (thing (cdr ml-elem)))
802 (if (string-match regexp infoval)
803 ;; we found a match, time to return
807 ;; else we didn't find a match
808 (setq mlist (cdr mlist))
809 ))) ;end of mlist loop
810 (setq alist (cdr alist))
811 )) ;end of alist loop
815 ;; ======================================================================
816 ;; extract mail field information from headers in reply buffer
818 ;; holder variables for bc happiness
819 (defvar sc-mail-headers-start nil
820 "Start of header fields.")
821 (defvar sc-mail-headers-end nil
822 "End of header fields.")
823 (defvar sc-mail-field-history nil
824 "For minibuffer completion on mail field queries.")
825 (defvar sc-mail-field-modification-history nil
826 "For minibuffer completion on mail field modifications.")
827 (defvar sc-mail-glom-frame
828 '((begin (setq sc-mail-headers-start (point)))
829 ("^x-attribution:[ \t]+.*$" (sc-mail-fetch-field t) nil t)
830 ("^\\S +:.*$" (sc-mail-fetch-field) nil t)
831 ("^$" (list 'abort '(step . 0)))
832 ("^[ \t]+" (sc-mail-append-field))
833 (sc-mail-warn-if-non-rfc822-p (sc-mail-error-in-mail-field))
834 (end (setq sc-mail-headers-end (point))))
835 "Regi frame for glomming mail header information.")
838 (defun sc-mail-fetch-field (&optional attribs-p)
839 "Insert a key and value into `sc-mail-info' alist.
840 If optional ATTRIBS-P is non-nil, the key/value pair is placed in
841 `sc-attributions' too."
842 (if (string-match "^\\(\\S *\\)\\s *:\\s +\\(.*\\)$" curline)
843 (let* ((key (downcase (sc-submatch 1 curline)))
844 (val (sc-submatch 2 curline))
845 (keyval (cons key val)))
846 (setq sc-mail-info (cons keyval sc-mail-info))
848 (setq sc-attributions (cons keyval sc-attributions)))
852 (defun sc-mail-append-field ()
853 "Append a continuation line onto the last fetched mail field's info."
854 (let ((keyval (car sc-mail-info)))
855 (if (and keyval (string-match "^\\s *\\(.*\\)$" curline))
856 (setcdr keyval (concat (cdr keyval) " " (sc-submatch 1 curline)))))
859 (defun sc-mail-error-in-mail-field ()
860 "Issue warning that mail headers don't conform to RFC 822."
861 (let* ((len (min (length curline) 10))
862 (ellipsis (if (< len (length curline)) "..." ""))
863 (msg "Mail header \"%s%s\" doesn't conform to RFC 822. skipping..."))
864 (message msg (substring curline 0 len) ellipsis))
869 ;; mail header nuking
870 (defvar sc-mail-last-header-nuked-p nil
871 "True if the last header was nuked.")
873 (defun sc-mail-nuke-line ()
874 "Nuke the current mail header line."
875 (delete-region (regi-pos 'bol) (regi-pos 'bonl))
878 (defun sc-mail-nuke-header-line ()
879 "Delete current-line and set up for possible continuation."
880 (setq sc-mail-last-header-nuked-p t)
883 (defun sc-mail-nuke-continuation-line ()
884 "Delete a continuation line if the last header line was deleted."
885 (if sc-mail-last-header-nuked-p
886 (sc-mail-nuke-line)))
888 (defun sc-mail-cleanup-blank-lines ()
889 "Leave some blank lines after original mail headers are nuked.
890 The number of lines left is specified by `sc-blank-lines-after-headers'."
891 (if sc-blank-lines-after-headers
894 (skip-chars-backward " \t\n")
898 (if (looking-at "[ \t]*$")
899 (delete-region (regi-pos 'bol) (regi-pos 'bonl)))
900 (insert-char ?\n sc-blank-lines-after-headers)))
903 (defun sc-mail-build-nuke-frame ()
904 "Build the regiframe for nuking mail headers."
905 (let (every-func entry-func nonentry-func)
907 ((eq sc-nuke-mail-headers 'all)
908 (setq every-func '(progn (forward-line -1) (sc-mail-nuke-line))))
909 ((eq sc-nuke-mail-headers 'specified)
910 (setq entry-func '(sc-mail-nuke-header-line)
911 nonentry-func '(setq sc-mail-last-header-nuked-p nil)))
912 ((eq sc-nuke-mail-headers 'keep)
913 (setq entry-func '(setq sc-mail-last-header-nuked-p nil)
914 nonentry-func '(sc-mail-nuke-header-line)))
915 ;; we never get far enough to interpret a frame if s-n-m-h == 'none
916 ((eq sc-nuke-mail-headers 'none))
917 (t (error "Illegal value for sc-nuke-mail-headers: %s"
918 sc-nuke-mail-headers))
922 (regi-mapcar sc-nuke-mail-header-list entry-func nil t))
923 (and nonentry-func (list (list "^\\S +:.*$" nonentry-func)))
924 (and (not every-func)
925 '(("^[ \t]+" (sc-mail-nuke-continuation-line))))
926 '((begin (setq sc-mail-last-header-zapped-p nil)))
927 '((end (sc-mail-cleanup-blank-lines)))
928 (and every-func (list (list 'every every-func)))
931 ;; mail processing and zapping. this is the top level entry defun to
932 ;; all header processing.
933 (defun sc-mail-process-headers (start end)
934 "Process original mail message's mail headers.
935 After processing, mail headers may be nuked. Header information is
936 stored in `sc-mail-info', and any old information is lost unless an
939 ;; Region may contain a whole message, so we must limit the rewrite-region
940 ;; function to just the headers, delimited by a blank line.
941 (if (fboundp sc-rewrite-region-function)
942 (funcall sc-rewrite-region-function start
944 (if (search-forward "\n\n" nil t)
947 (let ((info (copy-alist sc-mail-info))
948 (attribs (copy-alist sc-attributions)))
949 (setq sc-mail-info nil
951 (regi-interpret sc-mail-glom-frame start end)
952 (if (null sc-mail-info)
954 (message "No mail headers found! Restoring old information.")
955 (setq sc-mail-info info
956 sc-attributions attribs))
957 (regi-interpret (sc-mail-build-nuke-frame)
958 sc-mail-headers-start sc-mail-headers-end)
962 ;; let the user change mail field information
963 (defun sc-mail-field (field)
964 "Return the mail header field value associated with FIELD.
965 If there was no mail header with FIELD as its key, return the value of
966 `sc-mumble'. FIELD is case insensitive."
967 (or (cdr (assoc (downcase field) sc-mail-info)) sc-mumble))
969 (defun sc-mail-field-query (arg)
970 "View the value of a mail field.
971 With `\\[universal-argument]', prompts for action on mail field.
972 Action can be one of: View, Modify, Add, or Delete."
974 (let* ((alist '(("view" . ?v) ("modify" . ?m) ("add" . ?a) ("delete" . ?d)))
975 (action (if (not arg) ?v (sc-ask alist)))
979 (setq key (sc-completing-read
980 (concat (car (rassq action alist))
981 " information key: ")
983 (if (eq action ?a) nil 'noexit)
984 nil 'sc-mail-field-history))
987 (message "%s: %s" key (cdr (assoc key sc-mail-info))))
989 (setq sc-mail-info (delq (assoc key sc-mail-info) sc-mail-info)))
991 (let ((keyval (assoc key sc-mail-info)))
992 ;; first put initial value onto list if not already there
993 (if (not (sc-member (cdr keyval)
994 sc-mail-field-modification-history))
995 (setq sc-mail-field-modification-history
996 (cons (cdr keyval) sc-mail-field-modification-history)))
997 (setcdr keyval (sc-read-string
998 (concat key ": ") (cdr keyval)
999 'sc-mail-field-modification-history))))
1003 (sc-read-string (concat key ": "))) sc-mail-info)))
1007 ;; ======================================================================
1010 (defvar sc-attribution-confirmation-history nil
1011 "History for confirmation of attribution strings.")
1012 (defvar sc-citation-confirmation-history nil
1013 "History for confirmation of attribution prefixes.")
1015 (defun sc-attribs-%@-addresses (from &optional delim)
1016 "Extract the author's email terminus from email address FROM.
1017 Match addresses of the style ``name%[stuff].'' when called with DELIM
1018 of \"%\" and addresses of the style ``[stuff]name@[stuff]'' when
1019 called with DELIM \"@\". If DELIM is nil or not provided, matches
1020 addresses of the style ``name''."
1021 ;; Handle X.400 addresses where G & S fields contain the sender name.
1022 (if (string-match (concat "/[GS]=\\([-a-zA-Z0-9_.]+\\)\\|\\([-+a-zA-Z0-9_.]+\\)" delim) from)
1023 (if (match-beginning 2)
1024 (substring from (match-beginning 2) (match-end 2))
1025 (substring from (match-beginning 1) (match-end 1)))))
1027 (defun sc-attribs-!-addresses (from)
1028 "Extract the author's email terminus from email address FROM.
1029 Match addresses of the style ``[stuff]![stuff]...!name[stuff].''"
1030 (let ((eos (length from))
1031 (mstart (string-match "![-a-zA-Z0-9_.]+\\([^-!a-zA-Z0-9_.]\\|$\\)"
1033 (mend (match-end 0)))
1035 (substring from (1+ mstart) (- mend (if (= mend eos) 0 1)))
1038 (defun sc-attribs-<>-addresses (from)
1039 "Extract the author's email terminus from email address FROM.
1040 Match addresses of the style ``<name[stuff]>.''"
1041 (and (string-match "<\\(.*\\)>" from)
1042 (sc-submatch 1 from)))
1044 (defun sc-get-address (from author)
1045 "Get the full email address path from FROM.
1046 AUTHOR is the author's name (which is removed from the address)."
1047 (when (fboundp sc-rewrite-address-function)
1048 (setq from (funcall sc-rewrite-address-function from)))
1049 (let ((eos (length from)))
1050 (if (string-match (concat "\\(^\\|^\"\\)" author
1051 "\\(\\s +\\|\"\\s +\\)") from 0)
1052 (let ((address (substring from (match-end 0) eos)))
1053 (if (and (= (aref address 0) ?<)
1054 (= (aref address (1- (length address))) ?>))
1055 (substring address 1 (1- (length address)))
1057 (cond ((string-match "/[GS]=\\([-a-zA-Z0-9._]+\\)[^!@%]+\\([-a-zA-Z0-9!@%._]+\\)" from)
1058 ;; Motorola X.400 non-prettified address
1059 (concat (sc-submatch 1 from) (sc-submatch 2 from)))
1060 ((string-match "[-+a-zA-Z0-9!@%._]+" from)
1061 (sc-submatch 0 from))
1064 (defun sc-attribs-emailname (from)
1065 "Get the email terminus name from FROM."
1067 (sc-attribs-%@-addresses from "%")
1068 (sc-attribs-%@-addresses from "@")
1069 (sc-attribs-!-addresses from)
1070 (sc-attribs-<>-addresses from)
1071 (sc-attribs-%@-addresses from)
1072 (substring from 0 10)))
1074 (defun sc-name-substring (string start end extend)
1075 "Extract the specified substring of STRING from START to END.
1076 EXTEND is the number of characters on each side to extend the
1079 (let ((sos (+ start extend))
1080 (eos (- end extend)))
1081 (substring string sos
1082 (or (string-match sc-titlecue-regexp string sos) eos)
1085 (require 'mail-extr)
1087 (defun sc-attribs-extract-namestring (from)
1088 "Extract the name string from FROM.
1089 This should be the author's full name minus an optional title."
1090 (let ((from-parts (funcall sc-extract-address-components from)))
1091 (or (car from-parts)
1092 (and (cadr from-parts)
1093 (sc-attribs-emailname (cadr from-parts)))
1094 (error "cannot extract address components from %s" from))))
1096 (defun sc-attribs-chop-namestring (namestring)
1097 "Convert NAMESTRING to a list of names.
1098 example: (sc-attribs-chop-namestring \"John Xavier Doe\")
1099 => (\"John\" \"Xavier\" \"Doe\")"
1100 ;; Handle non-prettified Motorola X.400 addresses.
1101 (if (or (string-match "^\\([ \t]*\\)\\([^0-9 \t._-]+\\)\\(-[A-Za-z]+[0-9]+[A-Za-z0-9_]*[ \t]*\\)" namestring)
1103 "\\([ \t]*\\)\\([^ \t._]+\\)\\([ \t]*\\)"
1105 (cons (sc-submatch 2 namestring)
1106 (sc-attribs-chop-namestring (substring namestring (match-end 3)))
1109 (defun sc-attribs-strip-initials (namelist)
1110 "Extract the author's initials from the NAMELIST."
1114 (if (< 0 (length name))
1115 (substring name 0 1))))
1118 (defun sc-guess-attribution (&optional string)
1119 "Guess attribution string on current line.
1120 If attribution cannot be guessed, nil is returned. Optional STRING if
1121 supplied, is used instead of the line point is on in the current buffer."
1123 (string (or string (buffer-substring (regi-pos 'bol) (regi-pos 'eol))))
1126 (= start (or (string-match sc-citation-leader-regexp string start) -1))
1127 (setq start (match-end 0))
1128 (= start (or (string-match sc-citation-root-regexp string start) 1))
1129 (setq attribution (sc-submatch 0 string)
1130 start (match-end 0))
1131 (= start (or (string-match sc-citation-delimiter-regexp string start) -1))
1132 (setq start (match-end 0))
1133 (= start (or (string-match sc-citation-separator-regexp string start) -1))
1136 (defun sc-attribs-filter-namelist (namelist)
1137 "Filter out noise in NAMELIST according to `sc-name-filter-alist'."
1138 (let ((elements (length namelist))
1140 keepers filtered-list)
1144 (setq position (1+ position))
1149 (let ((regexp (car filter))
1151 (if (and (string-match regexp name)
1152 (or (and (numberp pos)
1155 (= position (1- elements)))
1159 sc-name-filter-alist)
1161 (setq keepers (cons position keepers)))
1167 (setq filtered-list (cons (nth position namelist) filtered-list))
1172 (defun sc-attribs-chop-address (from)
1173 "Extract attribution information from FROM.
1174 This populates the `sc-attributions' with the list of possible attributions."
1175 (if (and (stringp from)
1176 (< 0 (length from)))
1177 (let* ((sc-mumble "")
1178 (namestring (sc-attribs-extract-namestring from))
1179 (namelist (sc-attribs-filter-namelist
1180 (sc-attribs-chop-namestring namestring)))
1181 (revnames (reverse (cdr namelist)))
1182 (firstname (car namelist))
1183 (midnames (reverse (cdr revnames)))
1184 (lastname (car revnames))
1185 (initials (sc-attribs-strip-initials namelist))
1186 (emailname (sc-attribs-emailname from))
1190 ;; put basic information
1192 ;; put middle names and build sc-author entry
1193 middlenames (mapconcat
1196 (let ((key-attribs (format "middlename-%d" n))
1197 (key-mail (format "sc-middlename-%d" n)))
1199 sc-attributions (cons (cons key-attribs midname)
1201 sc-mail-info (cons (cons key-mail midname)
1207 author (concat firstname " " middlenames (and midnames " ") lastname)
1209 sc-attributions (append
1211 (cons "firstname" firstname)
1212 (cons "lastname" lastname)
1213 (cons "emailname" emailname)
1214 (cons "initials" initials))
1216 sc-mail-info (append
1218 (cons "sc-firstname" firstname)
1219 (cons "sc-middlenames" middlenames)
1220 (cons "sc-lastname" lastname)
1221 (cons "sc-emailname" emailname)
1222 (cons "sc-initials" initials)
1223 (cons "sc-author" author)
1224 (cons "sc-from-address" (sc-get-address
1225 (sc-mail-field "from")
1227 (cons "sc-reply-address" (sc-get-address
1228 (sc-mail-field "reply-to")
1230 (cons "sc-sender-address" (sc-get-address
1231 (sc-mail-field "sender")
1236 ;; from string is empty
1237 (setq sc-mail-info (cons (cons "sc-author" sc-default-author-name)
1240 (defvar sc-attrib-or-cite nil
1241 "Used to toggle between attribution input or citation input.")
1243 (defun sc-toggle-fn ()
1244 "Toggle between attribution selection and citation selection.
1245 Only used during confirmation."
1247 (setq sc-attrib-or-cite (not sc-attrib-or-cite))
1248 (throw 'sc-reconfirm t))
1250 (defun sc-select-attribution ()
1251 "Select an attribution from `sc-attributions'.
1253 Variables involved in selection process include:
1254 `sc-preferred-attribution-list'
1255 `sc-use-only-preference-p'
1256 `sc-confirm-always-p'
1257 `sc-default-attribution'
1258 `sc-attrib-selection-list'.
1260 Runs the hook `sc-attribs-preselect-hook' before selecting an
1261 attribution and the hook `sc-attribs-postselect-hook' after making the
1262 selection but before querying is performed. During
1263 `sc-attribs-postselect-hook' the variable `citation' is bound to the
1264 auto-selected citation string and the variable `attribution' is bound
1265 to the auto-selected attribution string."
1266 (run-hooks 'sc-attribs-preselect-hook)
1267 (let ((query-p sc-confirm-always-p)
1268 attribution citation
1269 (attriblist sc-preferred-attribution-list))
1271 ;; first cruise through sc-preferred-attribution-list looking for
1272 ;; a match in either sc-attributions or sc-mail-info. if the
1273 ;; element is "sc-consult", then we have to do the alist
1274 ;; consultation phase
1276 (let* ((preferred (car attriblist)))
1278 ((string= preferred "sc-consult")
1279 ;; we've been told to consult the attribution vs. mail
1280 ;; header key alist. we do this until we find a match in
1281 ;; the sc-attrib-selection-list. if we do not find a match,
1282 ;; we continue scanning attriblist
1283 (let ((attrib (sc-scan-info-alist sc-attrib-selection-list)))
1286 (setq attriblist (cdr attriblist)))
1288 (setq attribution attrib
1291 (setq attribution (eval attrib)
1293 (t (error "%s did not evaluate to a string or list!"
1294 "sc-attrib-selection-list"))
1296 ((setq attribution (cdr (assoc preferred sc-attributions)))
1297 (setq attriblist nil))
1299 (setq attriblist (cdr attriblist)))
1302 ;; if preference was not found, we may use a secondary method to
1303 ;; find a valid attribution
1304 (if (and (not attribution)
1305 (not sc-use-only-preference-p))
1306 ;; secondary method tries to find a preference in this order
1312 ;; 6. first non-empty attribution in alist
1314 (or (cdr (assoc "sc-lastchoice" sc-attributions))
1315 (cdr (assoc "x-attribution" sc-attributions))
1316 (cdr (assoc "firstname" sc-attributions))
1317 (cdr (assoc "lastname" sc-attributions))
1318 (cdr (assoc "initials" sc-attributions))
1319 (cdr (car sc-attributions)))))
1321 ;; still couldn't find an attribution. we're now limited to using
1322 ;; the default attribution, but we'll force a query when this happens
1323 (if (not attribution)
1324 (setq attribution sc-default-attribution
1327 ;; create the attribution prefix
1328 (setq citation (sc-make-citation attribution))
1330 ;; run the post selection hook before querying the user
1331 (run-hooks 'sc-attribs-postselect-hook)
1333 ;; query for confirmation
1335 (let* ((query-alist (mapcar (function (lambda (entry)
1336 (list (cdr entry))))
1338 (minibuffer-local-completion-map
1339 sc-minibuffer-local-completion-map)
1340 (minibuffer-local-map sc-minibuffer-local-map)
1341 (initial attribution)
1342 (completer-disable t) ; in case completer.el is used
1344 (setq sc-attrib-or-cite nil) ; nil==attribution, t==citation
1346 (catch 'sc-reconfirm
1347 (string= "" (setq choice
1348 (if sc-attrib-or-cite
1350 "Enter citation prefix: "
1352 'sc-citation-confirmation-history)
1354 "Complete attribution name: "
1357 'sc-attribution-confirmation-history)
1359 (if sc-attrib-or-cite
1360 ;; since the citation was chosen, we have to guess at
1362 (setq citation choice
1363 attribution (or (sc-guess-attribution citation)
1366 (setq citation (sc-make-citation choice)
1367 attribution choice))
1370 ;; its possible that the user wants to downcase the citation and
1373 (setq citation (downcase citation)
1374 attribution (downcase attribution)))
1376 ;; set up mail info alist
1377 (let* ((ckey "sc-citation")
1378 (akey "sc-attribution")
1379 (ckeyval (assoc ckey sc-mail-info))
1380 (akeyval (assoc akey sc-mail-info)))
1382 (setcdr ckeyval citation)
1384 (append (list (cons ckey citation)) sc-mail-info)))
1386 (setcdr akeyval attribution)
1388 (append (list (cons akey attribution)) sc-mail-info))))
1390 ;; set the sc-lastchoice attribution
1391 (let* ((lkey "sc-lastchoice")
1392 (lastchoice (assoc lkey sc-attributions)))
1394 (setcdr lastchoice attribution)
1395 (setq sc-attributions
1396 (cons (cons lkey attribution) sc-attributions))))
1400 ;; ======================================================================
1401 ;; filladapt hooks for supercite 3.1. you shouldn't need anything
1402 ;; extra to make gin-mode understand supercited lines. Even this
1403 ;; stuff might not be entirely necessary...
1405 (defun sc-cite-regexp (&optional root-regexp)
1406 "Return a regexp describing a Supercited line.
1407 The regexp is the concatenation of `sc-citation-leader-regexp',
1408 `sc-citation-root-regexp', `sc-citation-delimiter-regexp', and
1409 `sc-citation-separator-regexp'. If optional ROOT-REGEXP is supplied,
1410 use it instead of `sc-citation-root-regexp'."
1411 (concat sc-citation-leader-regexp
1412 (or root-regexp sc-citation-root-regexp)
1413 sc-citation-delimiter-regexp
1414 sc-citation-separator-regexp))
1416 (defun sc-make-citation (attribution)
1417 "Make a non-nested citation from ATTRIBUTION."
1418 (concat sc-citation-leader
1420 sc-citation-delimiter
1421 sc-citation-separator))
1423 (defun sc-setup-filladapt ()
1424 "Setup `filladapt-prefix-table' to handle Supercited paragraphs."
1425 (if (boundp 'filladapt-prefix-table)
1426 (let* ((fa-sc-elt 'filladapt-supercite-included-text)
1427 (elt (rassq fa-sc-elt filladapt-prefix-table)))
1428 (if elt (setcar elt (sc-cite-regexp))
1429 (message "Filladapt doesn't seem to know about Supercite.")
1433 ;; ======================================================================
1434 ;; citing and unciting regions of text
1436 (defvar sc-fill-begin 1
1437 "Buffer position to begin filling.")
1438 (defvar sc-fill-line-prefix ""
1439 "Fill prefix of previous line")
1442 (defun sc-fill-if-different (&optional prefix)
1443 "Fill the region bounded by `sc-fill-begin' and point.
1444 Only fill if optional PREFIX is different than `sc-fill-line-prefix'.
1445 If `sc-auto-fill-region-p' is nil, do not fill region. If PREFIX is
1446 not supplied, initialize fill variables. This is useful for a regi
1447 `begin' frame-entry."
1449 (setq sc-fill-line-prefix ""
1450 sc-fill-begin (regi-pos 'bol))
1451 (if (and sc-auto-fill-region-p
1452 (not (string= prefix sc-fill-line-prefix)))
1453 (let ((fill-prefix sc-fill-line-prefix))
1454 (if (not (string= fill-prefix ""))
1455 (fill-region sc-fill-begin (regi-pos 'bol)))
1456 (setq sc-fill-line-prefix prefix
1457 sc-fill-begin (regi-pos 'bol))))
1461 (defun sc-cite-coerce-cited-line ()
1462 "Coerce a Supercited line to look like our style."
1463 (let* ((attribution (sc-guess-attribution))
1464 (regexp (sc-cite-regexp attribution))
1465 (prefix (sc-make-citation attribution)))
1466 (if (and attribution
1467 (looking-at regexp))
1472 (goto-char (match-end 0))
1473 (if (bolp) (forward-char -1))
1476 (sc-fill-if-different prefix)))
1479 (defun sc-cite-coerce-dumb-citer ()
1480 "Coerce a non-nested citation that's been cited with a dumb nesting citer."
1481 (delete-region (match-beginning 1) (match-end 1))
1483 (sc-cite-coerce-cited-line))
1485 (defun sc-guess-nesting (&optional string)
1486 "Guess the citation nesting on the current line.
1487 If nesting cannot be guessed, nil is returned. Optional STRING if
1488 supplied, is used instead of the line point is on in the current
1491 (string (or string (buffer-substring (regi-pos 'bol) (regi-pos 'eol))))
1494 (= start (or (string-match sc-citation-leader-regexp string start) -1))
1495 (setq start (match-end 0))
1496 (= start (or (string-match sc-citation-delimiter-regexp string start) -1))
1497 (setq nesting (sc-submatch 0 string)
1498 start (match-end 0))
1499 (= start (or (string-match sc-citation-separator-regexp string start) -1))
1502 (defun sc-add-citation-level ()
1503 "Add a citation level for nested citation style w/ coersion."
1504 (let* ((nesting (sc-guess-nesting))
1505 (citation (make-string (1+ (length nesting))
1506 (string-to-char sc-citation-delimiter)))
1507 (prefix (concat sc-citation-leader citation sc-citation-separator)))
1508 (if (looking-at (sc-cite-regexp ""))
1509 (delete-region (match-beginning 0) (match-end 0)))
1511 (sc-fill-if-different prefix)))
1513 (defun sc-cite-line (&optional citation)
1514 "Cite a single line of uncited text.
1515 Optional CITATION overrides any citation automatically selected."
1516 (if sc-fixup-whitespace-p
1518 (let ((prefix (or citation
1519 (cdr (assoc "sc-citation" sc-mail-info))
1520 sc-default-attribution)))
1522 (sc-fill-if-different prefix))
1525 (defun sc-uncite-line ()
1526 "Remove citation from current line."
1527 (let ((cited (looking-at (sc-cite-regexp))))
1529 (delete-region (match-beginning 0) (match-end 0))))
1532 (defun sc-recite-line (regexp)
1533 "Remove citation matching REGEXP from current line and recite line."
1534 (let ((cited (looking-at (concat "^" regexp)))
1535 (prefix (cdr (assoc "sc-citation" sc-mail-info))))
1537 (delete-region (match-beginning 0) (match-end 0)))
1538 (insert (or prefix sc-default-attribution))
1539 (sc-fill-if-different prefix))
1542 ;; interactive functions
1543 (defun sc-cite-region (start end &optional confirm-p)
1544 "Cite a region delineated by START and END.
1545 If optional CONFIRM-P is non-nil, the attribution is confirmed before
1546 its use in the citation string. This function first runs
1547 `sc-pre-cite-hook'."
1548 (interactive "r\nP")
1550 (let ((frame (or (sc-scan-info-alist sc-cite-frame-alist)
1551 sc-default-cite-frame))
1552 (sc-confirm-always-p (if confirm-p t sc-confirm-always-p)))
1553 (run-hooks 'sc-pre-cite-hook)
1555 (sc-select-attribution))
1556 (regi-interpret frame start end)))
1558 (defun sc-uncite-region (start end)
1559 "Uncite a region delineated by START and END.
1560 First runs `sc-pre-uncite-hook'."
1563 (let ((frame (or (sc-scan-info-alist sc-uncite-frame-alist)
1564 sc-default-uncite-frame)))
1565 (run-hooks 'sc-pre-uncite-hook)
1566 (regi-interpret frame start end)))
1568 (defun sc-recite-region (start end)
1569 "Recite a region delineated by START and END.
1570 First runs `sc-pre-recite-hook'."
1572 (let ((sc-confirm-always-p t))
1573 (sc-select-attribution))
1575 (let ((frame (or (sc-scan-info-alist sc-recite-frame-alist)
1576 sc-default-recite-frame)))
1577 (run-hooks 'sc-pre-recite-hook)
1578 (regi-interpret frame start end)))
1581 ;; ======================================================================
1584 (defun sc-hdr (prefix field &optional sep return-nil-p)
1585 "Returns a concatenation of PREFIX and FIELD.
1586 If FIELD is not a string or is the empty string, the empty string will
1587 be returned. Optional third argument SEP is concatenated on the end if
1588 it is a string. Returns empty string, unless optional RETURN-NIL-P is
1590 (if (and (stringp field)
1591 (not (string= field "")))
1592 (concat prefix field (or sep ""))
1593 (and (not return-nil-p) "")))
1595 (defun sc-whofrom ()
1596 "Return the value of (sc-mail-field \"from\") or nil."
1597 (let ((sc-mumble nil))
1598 (sc-mail-field "from")))
1600 (defun sc-no-header ()
1601 "Does nothing. Use this instead of nil to get a blank header."
1604 (defun sc-no-blank-line-or-header()
1605 "Similar to `sc-no-header' except it removes the preceding blank line."
1608 (progn (forward-line -1)
1609 (or (looking-at mail-header-separator)
1610 (and (eq major-mode 'mh-letter-mode)
1611 (mh-in-header-p)))))
1612 (progn (forward-line)
1613 (let ((kill-lines-magic t))
1616 (defun sc-header-on-said ()
1617 "\"On <date>, <from> said:\" unless:
1618 1. the \"from\" field cannot be found, in which case nothing is inserted;
1619 2. the \"date\" field is missing in which case only the from part is printed."
1620 (let ((sc-mumble "")
1621 (whofrom (sc-whofrom)))
1623 (insert sc-reference-tag-string
1624 (sc-hdr "On " (sc-mail-field "date") ", ")
1625 whofrom " said:\n"))))
1627 (defun sc-header-inarticle-writes ()
1628 "\"In article <message-id>, <from> writes:\"
1629 Treats \"message-id\" and \"from\" fields similar to `sc-header-on-said'."
1630 (let ((sc-mumble "")
1631 (whofrom (sc-mail-field "from")))
1633 (insert sc-reference-tag-string
1634 (sc-hdr "In article " (sc-mail-field "message-id") ", ")
1635 whofrom " writes:\n"))))
1637 (defun sc-header-regarding-adds ()
1638 "\"Regarding <subject>; <from> adds:\"
1639 Treats \"subject\" and \"from\" fields similar to `sc-header-on-said'."
1640 (let ((sc-mumble "")
1641 (whofrom (sc-whofrom)))
1643 (insert sc-reference-tag-string
1644 (sc-hdr "Regarding " (sc-mail-field "subject") "; ")
1645 whofrom " adds:\n"))))
1647 (defun sc-header-attributed-writes ()
1648 "\"<sc-attribution>\" == <sc-author> <address> writes:
1649 Treats these fields in a similar manner to `sc-header-on-said'."
1650 (let ((sc-mumble "")
1651 (whofrom (sc-whofrom)))
1653 (insert sc-reference-tag-string
1654 (sc-hdr "\"" (sc-mail-field "sc-attribution") "\" == ")
1655 (sc-hdr "" (sc-mail-field "sc-author") " ")
1656 (or (sc-hdr "<" (sc-mail-field "sc-from-address") ">" t)
1657 (sc-hdr "<" (sc-mail-field "sc-reply-address") ">" t)
1661 (defun sc-header-author-writes ()
1662 "<sc-author> writes:"
1663 (let ((sc-mumble "")
1664 (whofrom (sc-whofrom)))
1666 (insert sc-reference-tag-string
1667 (sc-hdr "" (sc-mail-field "sc-author"))
1670 (defun sc-header-verbose ()
1671 "Very verbose, some say gross."
1672 (let ((sc-mumble "")
1673 (whofrom (sc-whofrom))
1674 (tag sc-reference-tag-string))
1676 (insert (sc-hdr (concat tag "On ") (sc-mail-field "date") ",\n")
1677 (or (sc-hdr tag (sc-mail-field "sc-author") "\n" t)
1678 (concat tag whofrom "\n"))
1679 (sc-hdr (concat tag "from the organization of ")
1680 (sc-mail-field "organization") "\n")
1681 (let ((rtag (concat tag "who can be reached at: ")))
1682 (or (sc-hdr rtag (sc-mail-field "sc-from-address") "\n" t)
1683 (sc-hdr rtag (sc-mail-field "sc-reply-address") "\n" t)
1686 (concat tag "(whose comments are cited below with \"")
1687 (sc-mail-field "sc-citation") "\"),\n")
1688 (sc-hdr (concat tag "had this to say in article ")
1689 (sc-mail-field "message-id") "\n")
1690 (sc-hdr (concat tag "in newsgroups ")
1691 (sc-mail-field "newsgroups") "\n")
1692 (sc-hdr (concat tag "concerning the subject of ")
1693 (sc-mail-field "subject") "\n")
1694 (sc-hdr (concat tag "(see ")
1695 (sc-mail-field "references")
1696 " for more details)\n")
1699 ;; Added by Steve Baur <steve@xemacs.org> Apr-02-1997.
1700 (defun sc-header-author-email-writes ()
1701 "sc-author <email-addr> writes:"
1702 (let ((sc-mumble "")
1703 (whofrom (sc-whofrom)))
1705 (insert sc-reference-tag-string
1706 (sc-hdr "" (sc-mail-field "sc-author") " ")
1707 (or (sc-hdr "<" (sc-mail-field "sc-from-address") ">" t)
1708 (sc-hdr "<" (sc-mail-field "sc-reply-address") ">" t)
1713 ;; ======================================================================
1716 (defconst sc-electric-bufname " *sc-erefs* "
1717 "Supercite electric reference mode's buffer name.")
1718 (defvar sc-eref-style 0
1719 "Current electric reference style.")
1721 (defun sc-valid-index-p (index)
1722 "Returns INDEX if it is a valid index into `sc-rewrite-header-list'.
1723 Otherwise returns nil."
1724 ;; a number, and greater than or equal to zero
1725 ;; less than or equal to the last index
1726 (and (natnump index)
1727 (< index (length sc-rewrite-header-list))
1730 (defun sc-eref-insert-selected (&optional nomsg)
1731 "Insert the selected reference header in the current buffer.
1732 Optional NOMSG, if non-nil, inhibits printing messages, unless an
1734 (let ((ref (nth sc-eref-style sc-rewrite-header-list)))
1738 (let ((lines (count-lines (point-min) (point-max))))
1739 (or nomsg (message "Ref header %d [%d line%s]: %s"
1741 (if (= lines 1) "" "s")
1745 "Symbol's function definition is void: %s (Header %d)"
1746 (car (cdr err)) sc-eref-style)
1751 (defun sc-electric-mode (&optional arg)
1753 Mode for viewing Supercite reference headers. Commands are:
1754 \n\\{sc-electric-mode-map}
1756 `sc-electric-mode' is not intended to be run interactively, but rather
1757 accessed through Supercite's electric reference feature. See
1758 `sc-insert-reference' for more details. Optional ARG is the initial
1759 header style to use, unless not supplied or invalid, in which case
1760 `sc-preferred-header-style' is used."
1762 (let ((info sc-mail-info))
1765 (or (sc-valid-index-p arg)
1766 (sc-valid-index-p sc-preferred-header-style)
1769 (get-buffer-create sc-electric-bufname)
1770 ;; set up buffer and enter command loop
1772 (save-window-excursion
1773 (pop-to-buffer sc-electric-bufname)
1774 (kill-all-local-variables)
1775 (let ((sc-mail-info info)
1776 (buffer-read-only t)
1777 (mode-name "SC Electric Refs")
1778 (major-mode 'sc-electric-mode))
1779 (use-local-map sc-electric-mode-map)
1780 (sc-eref-show sc-eref-style)
1781 (run-hooks 'sc-electric-mode-hook)
1786 (sc-eref-insert-selected))
1787 (kill-buffer sc-electric-bufname)
1790 ;; functions for electric reference mode
1791 (defun sc-eref-show (index)
1792 "Show reference INDEX in `sc-rewrite-header-list'."
1793 (let ((msg "No %ing reference headers in list.")
1794 (last (length sc-rewrite-header-list)))
1797 ((sc-valid-index-p index) index)
1799 (if sc-electric-circular-p
1801 (progn (error msg "preced") 0)))
1803 (if sc-electric-circular-p
1805 (progn (error msg "follow") (1- last))))
1808 (set-buffer sc-electric-bufname)
1809 (let ((buffer-read-only nil))
1811 (goto-char (point-min))
1812 (sc-eref-insert-selected)
1813 ;; now shrink the window to just contain the electric reference
1815 (let ((hdrlines (count-lines (point-min) (point-max)))
1816 (winlines (1- (window-height))))
1817 (if (/= hdrlines winlines)
1818 (if (> hdrlines winlines)
1819 ;; we have to enlarge the window
1820 (enlarge-window (- hdrlines winlines))
1821 ;; we have to shrink the window
1822 (shrink-window (- winlines (max hdrlines window-min-height)))
1826 (defun sc-eref-next ()
1827 "Display next reference in other buffer."
1829 (sc-eref-show (1+ sc-eref-style)))
1831 (defun sc-eref-prev ()
1832 "Display previous reference in other buffer."
1834 (sc-eref-show (1- sc-eref-style)))
1836 (defun sc-eref-setn ()
1837 "Set reference header selected as preferred."
1839 (setq sc-preferred-header-style sc-eref-style)
1840 (message "Preferred reference style set to header %d." sc-eref-style))
1842 (defun sc-eref-goto (refnum)
1843 "Show reference style indexed by REFNUM.
1844 If REFNUM is an invalid index, don't go to that reference and return
1846 (interactive "NGoto Reference: ")
1847 (if (sc-valid-index-p refnum)
1848 (sc-eref-show refnum)
1849 (error "Invalid reference: %d. (Range: [%d .. %d])"
1850 refnum 0 (1- (length sc-rewrite-header-list)))
1853 (defun sc-eref-jump ()
1854 "Set reference header to preferred header."
1856 (sc-eref-show sc-preferred-header-style))
1858 (defun sc-eref-abort ()
1859 "Exit from electric reference mode without inserting reference."
1861 (setq sc-eref-style nil)
1862 (exit-recursive-edit))
1864 (defun sc-eref-exit ()
1865 "Exit from electric reference mode and insert selected reference."
1867 (exit-recursive-edit))
1869 (defun sc-insert-reference (arg)
1870 "Insert, at point, a reference header in the body of the reply.
1871 Numeric ARG indicates which header style from `sc-rewrite-header-list'
1872 to use when rewriting the header. No supplied ARG indicates use of
1873 `sc-preferred-header-style'.
1875 With just `\\[universal-argument]', electric reference insert mode is
1876 entered, regardless of the value of `sc-electric-references-p'. See
1877 `sc-electric-mode' for more information."
1881 (let ((preference (or (sc-valid-index-p arg)
1882 (sc-valid-index-p sc-preferred-header-style)
1883 sc-preferred-header-style
1885 (if sc-electric-references-p
1886 (sc-electric-mode preference)
1887 (sc-eref-insert-selected t)
1891 ;; ======================================================================
1892 ;; variable toggling
1894 (defun sc-raw-mode-toggle ()
1895 "Toggle, in one fell swoop, two important SC variables:
1896 `sc-fixup-whitespace-p' and `sc-auto-fill-region-p'"
1898 (setq sc-fixup-whitespace-p (not sc-fixup-whitespace-p)
1899 sc-auto-fill-region-p (not sc-auto-fill-region-p))
1900 (sc-set-mode-string)
1901 (set-buffer-modified-p (buffer-modified-p)))
1903 (defun sc-toggle-var (variable)
1904 "Boolean toggle VARIABLE's value.
1905 VARIABLE must be a bound symbol. Nil values change to t, non-nil
1906 values are changed to nil."
1907 (message "%s changed from %s to %s"
1908 variable (symbol-value variable)
1909 (set-variable variable (not (eval-expression variable))))
1910 (sc-set-mode-string))
1912 (defun sc-set-variable (var)
1913 "Set the Supercite VARIABLE.
1914 This function mimics `set-variable', except that the variable to set
1915 is determined non-interactively. The value is queried for in the
1916 minibuffer exactly the same way that `set-variable' does it.
1918 You can see the current value of the variable when the minibuffer is
1919 querying you by typing `C-h'. Note that the format is changed
1920 slightly from that used by `set-variable' -- the current value is
1921 printed just after the variable's name instead of at the bottom of the
1923 (let* ((minibuffer-help-form
1928 (with-output-to-temp-buffer "*Help*"
1931 (let ((print-length 20))
1932 (princ "\t(Current value: ")
1933 (prin1 (symbol-value var))
1935 (princ "\n\nDocumentation:\n")
1936 (princ (substring (documentation-property
1938 'variable-documentation)
1941 (set var (eval-minibuffer (format "Set %s to value: " var))))
1942 (sc-set-mode-string))
1944 (defmacro sc-toggle-symbol (rootname)
1945 (list 'defun (intern (concat "sc-T-" rootname)) '()
1947 (list 'sc-toggle-var
1948 (list 'quote (intern (concat "sc-" rootname "-p"))))))
1950 (defmacro sc-setvar-symbol (rootname)
1951 (list 'defun (intern (concat "sc-S-" rootname)) '()
1953 (list 'sc-set-variable
1954 (list 'quote (intern (concat "sc-" rootname))))))
1956 (sc-toggle-symbol "confirm-always")
1957 (sc-toggle-symbol "downcase")
1958 (sc-toggle-symbol "electric-references")
1959 (sc-toggle-symbol "auto-fill-region")
1960 (sc-toggle-symbol "mail-nuke-blank-lines")
1961 (sc-toggle-symbol "nested-citation")
1962 (sc-toggle-symbol "electric-circular")
1963 (sc-toggle-symbol "use-only-preferences")
1964 (sc-toggle-symbol "fixup-whitespace")
1966 (sc-setvar-symbol "preferred-attribution-list")
1967 (sc-setvar-symbol "preferred-header-style")
1968 (sc-setvar-symbol "mail-nuke-mail-headers")
1969 (sc-setvar-symbol "mail-header-nuke-list")
1970 (sc-setvar-symbol "cite-region-limit")
1972 (defun sc-T-describe ()
1975 Supercite provides a number of key bindings which simplify the process
1976 of setting or toggling certain variables controlling its operation.
1978 Note on function names in this list: all functions of the form
1979 `sc-S-<name>' actually call `sc-set-variable' on the corresponding
1980 `sc-<name>' variable. All functions of the form `sc-T-<name>' call
1981 `sc-toggle-var' on the corresponding `sc-<name>-p' variable.
1985 (describe-function 'sc-T-describe))
1987 (defun sc-set-mode-string ()
1988 "Update the minor mode string to show state of Supercite."
1989 (setq sc-mode-string
1991 (if (or sc-auto-fill-region-p
1992 sc-fixup-whitespace-p)
1994 (if sc-auto-fill-region-p "f" "")
1995 (if sc-fixup-whitespace-p "w" "")
1999 ;; ======================================================================
2000 ;; published interface to mail and news readers
2003 (defun sc-cite-original ()
2004 "Workhorse citing function which performs the initial citation.
2005 This is callable from the various mail and news readers' reply
2006 function according to the agreed upon standard. See `sc-describe'
2007 for more details. `sc-cite-original' does not do any yanking of the
2008 original message but it does require a few things:
2010 1) The reply buffer is the current buffer.
2012 2) The original message has been yanked and inserted into the
2015 3) Verbose mail headers from the original message have been
2016 inserted into the reply buffer directly before the text of the
2019 4) Point is at the beginning of the verbose headers.
2021 5) Mark is at the end of the body of text to be cited.
2023 For Emacs 19's, the region need not be active (and typically isn't
2024 when this function is called. Also, the hook `sc-pre-hook' is run
2025 before, and `sc-post-hook' is run after the guts of this function."
2026 (run-hooks 'sc-pre-hook)
2028 ;; before we do anything, we want to insert the supercite keymap so
2029 ;; we can proceed from here
2030 (and sc-mode-map-prefix
2031 (local-set-key sc-mode-map-prefix sc-mode-map))
2033 ;; hack onto the minor mode alist, if it hasn't been done before,
2034 ;; then turn on the minor mode. also, set the minor mode string with
2035 ;; the values of fill and fixup whitespace variables
2036 (if (not (get 'minor-mode-alist 'sc-minor-mode))
2038 (put 'minor-mode-alist 'sc-minor-mode 'sc-minor-mode)
2039 (setq minor-mode-alist
2040 (cons '(sc-minor-mode sc-mode-string) minor-mode-alist))
2042 (setq sc-minor-mode t)
2043 (sc-set-mode-string)
2047 ;; grab point and mark since the region is probably not active when
2048 ;; this function gets automatically called. we want point to be a
2049 ;; mark so any deleting before point works properly
2050 (let* ((zmacs-regions nil) ; for XEmacs
2051 (mark-active t) ; for FSFmacs
2052 (point (point-marker))
2053 (mark (copy-marker (mark-marker))))
2055 ;; make sure point comes before mark, not all functions are
2062 ;; first process mail headers, and populate sc-mail-info
2063 (sc-mail-process-headers point mark)
2065 ;; now get possible attributions
2066 (sc-attribs-chop-address (or (sc-mail-field "from")
2067 (sc-mail-field "reply")
2068 (sc-mail-field "reply-to")
2069 (sc-mail-field "sender")))
2070 ;; select the attribution
2071 (sc-select-attribution)
2073 ;; cite the region, but first check the value of sc-cite-region-limit
2074 (let ((linecnt (count-lines point mark)))
2075 (and sc-cite-region-limit
2076 (if (or (not (numberp sc-cite-region-limit))
2077 (<= linecnt sc-cite-region-limit))
2079 ;; cite the region and insert the header rewrite
2080 (sc-cite-region point mark)
2082 (let ((sc-eref-style (or sc-preferred-header-style 0)))
2083 (if sc-electric-references-p
2084 (sc-electric-mode sc-eref-style)
2085 (sc-eref-insert-selected t))))
2088 "Region not cited. %d lines exceeds sc-cite-region-limit: %d"
2089 linecnt sc-cite-region-limit))))
2091 ;; finally, free the point-marker
2092 (set-marker point nil)
2093 (set-marker mark nil)
2095 (run-hooks 'sc-post-hook)
2096 ;; post hook could have changed the variables
2097 (sc-set-mode-string))
2100 ;; ======================================================================
2101 ;; bug reporting and miscellaneous commands
2103 (defun sc-open-line (arg)
2104 "Like `open-line', but insert the citation prefix at the front of the line.
2105 With numeric ARG, inserts that many new lines."
2108 (let ((start (point))
2109 (prefix (or (progn (beginning-of-line)
2110 (if (looking-at (sc-cite-regexp))
2122 (defun sc-insert-citation (arg)
2123 "Insert citation string at beginning of current line if not already cited.
2124 With `\\[universal-argument]' insert citation even if line is already
2129 (if (or (not (looking-at (sc-cite-regexp)))
2130 (looking-at "^[ \t]*$")
2132 (insert (sc-mail-field "sc-citation"))
2133 (error "Line is already cited."))))
2135 (defun sc-version (arg)
2136 "Echo the current version of Supercite in the minibuffer.
2137 With \\[universal-argument] (universal-argument), or if run non-interactively,
2138 inserts the version string in the current buffer instead."
2140 (let ((verstr (format "Using Supercite.el %s" sc-version)))
2142 (not (interactive-p)))
2143 (insert "`sc-version' says: " verstr)
2146 (defun sc-describe ()
2148 Supercite is a package which provides a flexible mechanism for citing
2149 email and news replies. Please see the associated texinfo file for
2152 (describe-function 'sc-describe))
2154 (defun sc-submit-bug-report ()
2155 "Submit a bug report on Supercite via mail."
2159 (y-or-n-p "Do you want to submit a report on Supercite? ")
2160 (reporter-submit-bug-report
2162 (concat "Supercite version " sc-version)
2164 'sc-attrib-selection-list
2165 'sc-auto-fill-region-p
2166 'sc-blank-lines-after-headers
2168 'sc-citation-delimiter
2169 'sc-citation-separator
2170 'sc-citation-leader-regexp
2171 'sc-citation-root-regexp
2172 'sc-citation-nonnested-root-regexp
2173 'sc-citation-delimiter-regexp
2174 'sc-citation-separator-regexp
2175 'sc-cite-region-limit
2176 'sc-confirm-always-p
2177 'sc-default-attribution
2178 'sc-default-author-name
2180 'sc-electric-circular-p
2181 'sc-electric-references-p
2182 'sc-fixup-whitespace-p
2183 'sc-mail-warn-if-non-rfc822-p
2185 'sc-name-filter-alist
2186 'sc-nested-citation-p
2187 'sc-nuke-mail-headers
2188 'sc-nuke-mail-header-list
2189 'sc-preferred-attribution-list
2190 'sc-preferred-header-style
2191 'sc-reference-tag-string
2192 'sc-rewrite-header-list
2194 'sc-use-only-preference-p
2199 (provide 'supercite)
2200 (run-hooks 'sc-load-hook)
2202 ;;; supercite.el ends here