lisp/mail/supercite.el

   1 ;;; supercite.el --- minor mode for citing mail and news replies
   2
   3 ;; Copyright (C) 1993, 1997, 2003 Free Software Foundation, Inc.
   4
   5 ;; Author: 1993 Barry A. Warsaw, Century Computing, Inc. <bwarsaw@cen.com>
   6 ;; Maintainer:    FSF
   7 ;; Created:       February 1993
   8 ;; Last Modified: 1993/09/22 18:58:46
   9 ;; Keywords: mail, news
  10
  11 ;; supercite.el revision: 3.54
  12
  13 ;; This file is part of GNU Emacs.
  14
  15 ;; GNU Emacs is free software; you can redistribute it and/or modify
  16 ;; it under the terms of the GNU General Public License as published by
  17 ;; the Free Software Foundation; either version 2, or (at your option)
  18 ;; any later version.
  19
  20 ;; GNU Emacs is distributed in the hope that it will be useful,
  21 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  23 ;; GNU General Public License for more details.
  24
  25 ;; You should have received a copy of the GNU General Public License
  26 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  27 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  28 ;; Boston, MA 02111-1307, USA.
  29
  30 ;; LCD Archive Entry
  31 ;; supercite|Barry A. Warsaw|supercite-help@python.org
  32 ;; |Mail and news reply citation package
  33 ;; |1993/09/22 18:58:46|3.1|
  34
  35 ;;; Commentary:
  36
  37 ;;; Code:
  38
  39 \f
  40 (require 'regi)
  41 (require 'sendmail)     ;; For mail-header-end.
  42
  43 ;; start user configuration variables
  44 ;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
  45
  46 (defgroup supercite nil
  47   "Supercite package"
  48   :prefix "sc-"
  49   :group 'mail
  50   :group 'news)
  51
  52 (defgroup supercite-frames nil
  53   "Supercite (regi) frames"
  54   :prefix "sc-"
  55   :group 'supercite)
  56
  57 (defgroup supercite-attr nil
  58   "Supercite attributions"
  59   :prefix "sc-"
  60   :group 'supercite)
  61
  62 (defgroup supercite-cite nil
  63   "Supercite citings"
  64   :prefix "sc-"
  65   :group 'supercite)
  66
  67 (defgroup supercite-hooks nil
  68   "Hooking into supercite"
  69   :prefix "sc-"
  70   :group 'supercite)
  71
  72 (defcustom sc-auto-fill-region-p t
  73   "*If non-nil, automatically fill each paragraph after it has been cited."
  74   :type 'boolean
  75   :group 'supercite)
  76
  77 (defcustom sc-blank-lines-after-headers 1
  78   "*Number of blank lines to leave after mail headers have been nuked.
  79 Set to nil, to use whatever blank lines happen to occur naturally."
  80   :type '(choice (const :tag "leave" nil)
  81                  integer)
  82   :group 'supercite)
  83
  84 (defcustom sc-citation-leader "    "
  85   "*String comprising first part of a citation."
  86   :type 'string
  87   :group 'supercite-cite)
  88
  89 (defcustom sc-citation-delimiter ">"
  90   "*String comprising third part of a citation.
  91 This string is used in both nested and non-nested citations."
  92   :type 'string
  93   :group 'supercite-cite)
  94
  95 (defcustom sc-citation-separator " "
  96   "*String comprising fourth and last part of a citation."
  97   :type 'string
  98   :group 'supercite-cite)
  99
 100 (defcustom sc-citation-leader-regexp "[ \t]*"
 101   "*Regexp describing citation leader for a cited line.
 102 This should NOT have a leading `^' character."
 103   :type 'regexp
 104   :group 'supercite-cite)
 105
 106 ;; Nemacs and Mule users note: please see the texinfo manual for
 107 ;; suggestions on setting these variables.
 108 (defcustom sc-citation-root-regexp "[-._[:alnum:]]*"
 109   "*Regexp describing variable root part of a citation for a cited line.
 110 This should NOT have a leading `^' character.  See also
 111 `sc-citation-nonnested-root-regexp'."
 112   :type 'regexp
 113   :group 'supercite-cite)
 114
 115 (defcustom sc-citation-nonnested-root-regexp "[-._[:alnum:]]+"
 116   "*Regexp describing the variable root part of a nested citation.
 117 This should NOT have a leading `^' character.  This variable is
 118 related to `sc-citation-root-regexp' but whereas that variable
 119 describes both nested and non-nested citation roots, this variable
 120 describes only nested citation roots."
 121   :type 'regexp
 122   :group 'supercite-cite)
 123
 124 (defcustom sc-citation-delimiter-regexp "[>]+"
 125   "*Regexp describing citation delimiter for a cited line.
 126 This should NOT have a leading `^' character."
 127   :type 'regexp
 128   :group 'supercite-cite)
 129
 130 (defcustom sc-citation-separator-regexp "[ \t]*"
 131   "*Regexp describing citation separator for a cited line.
 132 This should NOT have a leading `^' character."
 133   :type 'regexp
 134   :group 'supercite-cite)
 135
 136 (defcustom sc-cite-blank-lines-p nil
 137   "*If non-nil, put a citation on blank lines."
 138   :type 'boolean
 139   :group 'supercite-cite)
 140
 141 (defcustom sc-cite-frame-alist '()
 142   "*Alist for frame selection during citing.
 143 Each element of this list has the following form:
 144    (INFOKEY ((REGEXP . FRAME)
 145              (REGEXP . FRAME)
 146              (...)))
 147
 148 Where INFOKEY is a key for `sc-mail-field', REGEXP is a regular
 149 expression to match against the INFOKEY's value.  FRAME is a citation
 150 frame, or a variable containing a citation frame."
 151   :type '(repeat (list symbol (repeat (cons regexp
 152                                             (choice (repeat (repeat sexp))
 153                                                     symbol)))))
 154   :group 'supercite-frames)
 155
 156 (defcustom sc-uncite-frame-alist '()
 157   "*Alist for frame selection during unciting.
 158 See the variable `sc-cite-frame-alist' for details."
 159   :type '(repeat (list symbol (repeat (cons regexp
 160                                             (choice (repeat (repeat sexp))
 161                                                     symbol)))))
 162   :group 'supercite-frames)
 163
 164 (defcustom sc-recite-frame-alist '()
 165   "*Alist for frame selection during reciting.
 166 See the variable `sc-cite-frame-alist' for details."
 167   :type '(repeat (list symbol (repeat (cons regexp
 168                                             (choice (repeat (repeat sexp))
 169                                                     symbol)))))
 170   :group 'supercite-frames)
 171
 172 (defcustom sc-default-cite-frame
 173   '(;; initialize fill state and temporary variables when entering
 174     ;; frame. this makes things run much faster
 175     (begin (progn
 176              (sc-fill-if-different)
 177              (setq sc-tmp-nested-regexp (sc-cite-regexp "")
 178                    sc-tmp-nonnested-regexp (sc-cite-regexp)
 179                    sc-tmp-dumb-regexp
 180                    (concat "\\("
 181                            (sc-cite-regexp "")
 182                            "\\)"
 183                            (sc-cite-regexp sc-citation-nonnested-root-regexp))
 184                    )))
 185     ;; blank lines mean paragraph separators, so fill the last cited
 186     ;; paragraph, unless sc-cite-blank-lines-p is non-nil, in which
 187     ;; case we treat blank lines just like any other line.
 188     ("^[ \t]*$"                 (if sc-cite-blank-lines-p
 189                                     (sc-cite-line)
 190                                   (sc-fill-if-different "")))
 191     ;; do nothing if looking at a reference tag. make sure that the
 192     ;; tag string isn't the empty string since this will match every
 193     ;; line.  it cannot be nil.
 194     (sc-reference-tag-string    (if (string= sc-reference-tag-string "")
 195                                     (list 'continue)
 196                                   nil))
 197     ;; this regexp catches nested citations in which the author cited
 198     ;; a non-nested citation with a dumb citer.
 199     (sc-tmp-dumb-regexp         (sc-cite-coerce-dumb-citer))
 200     ;; if we are looking at a nested citation then add a citation level
 201     (sc-tmp-nested-regexp       (sc-add-citation-level))
 202     ;; if we're looking at a non-nested citation, coerce it to our style
 203     (sc-tmp-nonnested-regexp    (sc-cite-coerce-cited-line))
 204     ;; we must be looking at an uncited line. if we are in nested
 205     ;; citations, just add a citation level
 206     (sc-nested-citation-p       (sc-add-citation-level))
 207     ;; we're looking at an uncited line and we are in non-nested
 208     ;; citations, so cite it with a non-nested citation
 209     (t                          (sc-cite-line))
 210     ;; be sure when we're done that we fill the last cited paragraph.
 211     (end                        (sc-fill-if-different ""))
 212     )
 213   "*Default REGI frame for citing a region."
 214   :type '(repeat (repeat sexp))
 215   :group 'supercite-frames)
 216
 217 (defcustom sc-default-uncite-frame
 218   '(;; do nothing on a blank line
 219     ("^[ \t]*$"       nil)
 220     ;; if the line is cited, uncite it
 221     ((sc-cite-regexp) (sc-uncite-line))
 222     )
 223   "*Default REGI frame for unciting a region."
 224   :type '(repeat (repeat sexp))
 225   :group 'supercite-frames)
 226
 227 (defcustom sc-default-recite-frame
 228   '(;; initialize fill state when entering frame
 229     (begin            (sc-fill-if-different))
 230     ;; do nothing on a blank line
 231     ("^[ \t]*$"       nil)
 232     ;; if we're looking at a cited line, recite it
 233     ((sc-cite-regexp) (sc-recite-line (sc-cite-regexp)))
 234     ;; otherwise, the line is uncited, so just cite it
 235     (t                (sc-cite-line))
 236     ;; be sure when we're done that we fill the last cited paragraph.
 237     (end              (sc-fill-if-different ""))
 238     )
 239   "*Default REGI frame for reciting a region."
 240   :type '(repeat (repeat sexp))
 241   :group 'supercite-frames)
 242
 243 (defcustom sc-cite-region-limit t
 244   "*This variable controls automatic citation of yanked text.
 245 Legal values are:
 246
 247 non-nil   -- cite the entire region, regardless of its size
 248 nil       -- do not cite the region at all
 249 <integer> -- a number indicating the threshold for citation.  When
 250              the number of lines in the region is greater than this
 251              value, a warning message will be printed and the region
 252              will not be cited.  Lines in region are counted with
 253              `count-lines'.
 254
 255 The gathering of attribution information is not affected by the value
 256 of this variable.  The number of lines in the region is calculated
 257 *after* all mail headers are removed.  This variable is only consulted
 258 during the initial citing via `sc-cite-original'."
 259   :type '(choice (const :tag "do not cite" nil)
 260                  (integer :tag "citation threshold")
 261                  (other :tag "always cite" t))
 262   :group 'supercite-cite)
 263
 264 (defcustom sc-confirm-always-p t
 265   "*If non-nil, always confirm attribution string before citing text body."
 266   :type 'boolean
 267   :group 'supercite-attr)
 268
 269 (defcustom sc-default-attribution "Anon"
 270   "*String used when author's attribution cannot be determined."
 271   :type 'string
 272   :group 'supercite-attr)
 273 (defcustom sc-default-author-name "Anonymous"
 274   "*String used when author's name cannot be determined."
 275   :type 'string
 276   :group 'supercite-attr)
 277 (defcustom sc-downcase-p nil
 278   "*Non-nil means downcase the attribution and citation strings."
 279   :type 'boolean
 280   :group 'supercite-attr
 281   :group 'supercite-cite)
 282 (defcustom sc-electric-circular-p t
 283   "*If non-nil, treat electric references as circular."
 284   :type 'boolean
 285   :group 'supercite-attr)
 286
 287 (defcustom sc-electric-mode-hook nil
 288   "*Hook for `sc-electric-mode' electric references mode."
 289   :type 'hook
 290   :group 'supercite-hooks)
 291 (defcustom sc-electric-references-p nil
 292   "*Use electric references if non-nil."
 293   :type 'boolean
 294   :group 'supercite)
 295
 296 (defcustom sc-fixup-whitespace-p nil
 297   "*If non-nil, delete all leading white space before citing."
 298   :type 'boolean
 299   :group 'supercite)
 300
 301 (defcustom sc-load-hook nil
 302   "*Hook which gets run once after Supercite loads."
 303   :type 'hook
 304   :group 'supercite-hooks)
 305 (defcustom sc-pre-hook nil
 306   "*Hook which gets run before each invocation of `sc-cite-original'."
 307   :type 'hook
 308   :group 'supercite-hooks)
 309 (defcustom sc-post-hook nil
 310   "*Hook which gets run after each invocation of `sc-cite-original'."
 311   :type 'hook
 312   :group 'supercite-hooks)
 313
 314 (defcustom sc-mail-warn-if-non-rfc822-p t
 315   "*Warn if mail headers don't conform to RFC822."
 316   :type 'boolean
 317   :group 'supercite-attr)
 318 (defcustom sc-mumble ""
 319   "*Value returned by `sc-mail-field' if field isn't in mail headers."
 320   :type 'string
 321   :group 'supercite-attr)
 322
 323 (defcustom sc-name-filter-alist
 324   '(("^\\(Mr\\|Mrs\\|Ms\\|Dr\\)[.]?$" . 0)
 325     ("^\\(Jr\\|Sr\\)[.]?$" . last)
 326     ("^ASTS$" . 0)
 327     ("^[I]+$" . last))
 328   "*Name list components which are filtered out as noise.
 329 This variable contains an association list where each element is of
 330 the form:  (REGEXP . POSITION).
 331
 332 REGEXP is a regular expression which matches the name list component.
 333 Match is performed using `string-match'.  POSITION is the position in
 334 the name list which can match the regular expression, starting at zero
 335 for the first element.  Use `last' to match the last element in the
 336 list and `any' to match all elements."
 337   :type '(repeat (cons regexp (choice (const last) (const any)
 338                                       (integer :tag "position"))))
 339   :group 'supercite-attr)
 340
 341 (defcustom sc-nested-citation-p nil
 342   "*Controls whether to use nested or non-nested citation style.
 343 Non-nil uses nested citations, nil uses non-nested citations."
 344   :type 'boolean
 345   :group 'supercite)
 346
 347 (defcustom sc-nuke-mail-headers 'all
 348   "*Controls mail header nuking.
 349 Used in conjunction with `sc-nuke-mail-header-list'.  Legal values are:
 350
 351 `all'       -- nuke all mail headers
 352 `none'      -- don't nuke any mail headers
 353 `specified' -- nuke headers specified in `sc-nuke-mail-header-list'
 354 `keep'      -- keep headers specified in `sc-nuke-mail-header-list'"
 355   :type '(choice (const all) (const none)
 356                  (const specified) (const keep))
 357   :group 'supercite)
 358
 359 (defcustom sc-nuke-mail-header-list nil
 360   "*List of mail header regexps to remove or keep in body of reply.
 361 This list contains regular expressions describing the mail headers to
 362 keep or nuke, depending on the value of `sc-nuke-mail-headers'."
 363   :type '(repeat regexp)
 364   :group 'supercite)
 365
 366 (defcustom sc-preferred-attribution-list
 367   '("sc-lastchoice" "x-attribution" "firstname" "initials" "lastname")
 368   "*Specifies what to use as the attribution string.
 369 Supercite creates a list of possible attributions when it scans the
 370 mail headers from the original message.  Each attribution choice is
 371 associated with a key in an attribution alist.  Supercite tries to
 372 pick a \"preferred\" attribution by matching the attribution alist
 373 keys against the elements in `sc-preferred-attribution-list' in order.
 374 The first non-empty string value found is used as the preferred
 375 attribution.
 376
 377 Note that Supercite now honors the X-Attribution: mail field.  If
 378 present in the original message, the value of this field should always
 379 be used to select the most preferred attribution since it reflects how
 380 the original author would like to be distinguished.  It should be
 381 considered bad taste to put any attribution preference key before
 382 \"x-attribution\" in this list, except perhaps for \"sc-lastchoice\"
 383 \(see below).
 384
 385 Supercite remembers the last attribution used when reciting an already
 386 cited paragraph.  This attribution will always be saved with the
 387 \"sc-lastchoice\" key, which can be used in this list.  Note that the
 388 last choice is always reset after every call of `sc-cite-original'.
 389
 390 Barring error conditions, the following preferences are always present
 391 in the attribution alist:
 392
 393 \"emailname\"    -- email terminus name
 394 \"initials\"     -- initials of author
 395 \"firstname\"    -- first name of author
 396 \"lastname\"     -- last name of author
 397 \"middlename-1\" -- first middle name of author
 398 \"middlename-2\" -- second middle name of author
 399 ...
 400
 401 Middle name indexes can be any positive integer greater than 0,
 402 although it is unlikely that many authors will supply more than one
 403 middle name, if that many.  The string of all middle names is
 404 associated with the key \"middlenames\"."
 405   :type '(repeat string)
 406   :group 'supercite-attr)
 407
 408 (defcustom sc-attrib-selection-list nil
 409   "*An alist for selecting preferred attribution based on mail headers.
 410 Each element of this list has the following form:
 411
 412    (INFOKEY ((REGEXP . ATTRIBUTION)
 413              (REGEXP . ATTRIBUTION)
 414              (...)))
 415
 416 Where INFOKEY is a key for `sc-mail-field', REGEXP is a regular
 417 expression to match against the INFOKEY's value. ATTRIBUTION can be a
 418 string or a list.  If its a string, then it is the attribution that is
 419 selected by `sc-select-attribution'.  If it is a list, it is `eval'd
 420 and the return value must be a string, which is used as the selected
 421 attribution.  Note that the variable `sc-preferred-attribution-list'
 422 must contain an element of the string \"sc-consult\" for this variable
 423 to be consulted during attribution selection."
 424   :type '(repeat (list string
 425                        (repeat (cons regexp
 426                                      (choice (sexp :tag "List to eval")
 427                                              string)))))
 428   :group 'supercite-attr)
 429
 430 (defcustom sc-attribs-preselect-hook nil
 431   "*Hook to run before selecting an attribution."
 432   :type 'hook
 433   :group 'supercite-attr
 434   :group 'supercite-hooks)
 435 (defcustom sc-attribs-postselect-hook nil
 436   "*Hook to run after selecting an attribution, but before confirmation."
 437   :type 'hook
 438   :group 'supercite-attr
 439   :group 'supercite-hooks)
 440
 441 (defcustom sc-pre-cite-hook nil
 442   "*Hook to run before citing a region of text."
 443   :type 'hook
 444   :group 'supercite-cite
 445   :group 'supercite-hooks)
 446 (defcustom sc-pre-uncite-hook nil
 447   "*Hook to run before unciting a region of text."
 448   :type 'hook
 449   :group 'supercite-cite
 450   :group 'supercite-hooks)
 451 (defcustom sc-pre-recite-hook nil
 452   "*Hook to run before reciting a region of text."
 453   :type 'hook
 454   :group 'supercite-cite
 455   :group 'supercite-hooks)
 456
 457 (defcustom sc-preferred-header-style 4
 458   "*Index into `sc-rewrite-header-list' specifying preferred header style.
 459 Index zero accesses the first function in the list."
 460   :type 'integer
 461   :group 'supercite)
 462
 463 (defcustom sc-reference-tag-string ">>>>> "
 464   "*String used at the beginning of built-in reference headers."
 465   :type 'string
 466   :group 'supercite)
 467
 468 (defcustom sc-rewrite-header-list
 469   '((sc-no-header)
 470     (sc-header-on-said)
 471     (sc-header-inarticle-writes)
 472     (sc-header-regarding-adds)
 473     (sc-header-attributed-writes)
 474     (sc-header-author-writes)
 475     (sc-header-verbose)
 476     (sc-no-blank-line-or-header)
 477     )
 478   "*List of reference header rewrite functions.
 479 The variable `sc-preferred-header-style' controls which function in
 480 this list is chosen for automatic reference header insertions.
 481 Electric reference mode will cycle through this list of functions."
 482   :type '(repeat sexp)
 483   :group 'supercite)
 484
 485 (defcustom sc-titlecue-regexp "\\s +-+\\s +"
 486   "*Regular expression describing the separator between names and titles.
 487 Set to nil to treat entire field as a name."
 488   :type '(choice (const :tag "entire field as name" nil)
 489                  regexp)
 490   :group 'supercite-attr)
 491
 492 (defcustom sc-use-only-preference-p nil
 493   "*Controls what happens when the preferred attribution cannot be found.
 494 If non-nil, then `sc-default-attribution' will be used.  If nil, then
 495 some secondary scheme will be employed to find a suitable attribution
 496 string."
 497   :type 'boolean
 498   :group 'supercite-attr)
 499
 500 ;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
 501 ;; end user configuration variables
 502 \f
 503 (defconst sc-version "3.1"
 504   "Supercite version number.")
 505 (defconst sc-help-address "bug-supercite@gnu.org"
 506   "Address accepting submissions of bug reports.")
 507
 508 (defvar sc-mail-info nil
 509   "Alist of mail header information gleaned from reply buffer.")
 510 (defvar sc-attributions nil
 511   "Alist of attributions for use when citing.")
 512
 513 (defvar sc-tmp-nested-regexp nil
 514   "Temporary regexp describing nested citations.")
 515 (defvar sc-tmp-nonnested-regexp nil
 516   "Temporary regexp describing non-nested citations.")
 517 (defvar sc-tmp-dumb-regexp nil
 518   "Temp regexp describing non-nested citation cited with a nesting citer.")
 519
 520 (make-variable-buffer-local 'sc-mail-info)
 521 (make-variable-buffer-local 'sc-attributions)
 522
 523 \f
 524 ;; ======================================================================
 525 ;; supercite keymaps
 526
 527 (defvar sc-mode-map-prefix "\C-c\C-p"
 528   "*Key binding to install Supercite keymap.
 529 If this is nil, Supercite keymap is not installed.")
 530
 531 (defvar sc-T-keymap
 532   (let ((map (make-sparse-keymap)))
 533     (define-key map "a" 'sc-S-preferred-attribution-list)
 534     (define-key map "b" 'sc-T-mail-nuke-blank-lines)
 535     (define-key map "c" 'sc-T-confirm-always)
 536     (define-key map "d" 'sc-T-downcase)
 537     (define-key map "e" 'sc-T-electric-references)
 538     (define-key map "f" 'sc-T-auto-fill-region)
 539     (define-key map "h" 'sc-T-describe)
 540     (define-key map "l" 'sc-S-cite-region-limit)
 541     (define-key map "n" 'sc-S-mail-nuke-mail-headers)
 542     (define-key map "N" 'sc-S-mail-header-nuke-list)
 543     (define-key map "o" 'sc-T-electric-circular)
 544     (define-key map "p" 'sc-S-preferred-header-style)
 545     (define-key map "s" 'sc-T-nested-citation)
 546     (define-key map "u" 'sc-T-use-only-preferences)
 547     (define-key map "w" 'sc-T-fixup-whitespace)
 548     (define-key map "?" 'sc-T-describe)
 549     map)
 550   "Keymap for sub-keymap of setting and toggling functions.")
 551
 552 (defvar sc-mode-map
 553   (let ((map (make-sparse-keymap)))
 554     (define-key map "c"    'sc-cite-region)
 555     (define-key map "f"    'sc-mail-field-query)
 556     (define-key map "g"    'sc-mail-process-headers)
 557     (define-key map "h"    'sc-describe)
 558     (define-key map "i"    'sc-insert-citation)
 559     (define-key map "o"    'sc-open-line)
 560     (define-key map "r"    'sc-recite-region)
 561     (define-key map "\C-p" 'sc-raw-mode-toggle)
 562     (define-key map "u"    'sc-uncite-region)
 563     (define-key map "v"    'sc-version)
 564     (define-key map "w"    'sc-insert-reference)
 565     (define-key map "\C-t"  sc-T-keymap)
 566     (define-key map "\C-b" 'sc-submit-bug-report)
 567     (define-key map "?"    'sc-describe)
 568     map)
 569   "Keymap for Supercite quasi-mode.")
 570
 571 (defvar sc-electric-mode-map
 572   (let ((map (make-sparse-keymap)))
 573     (define-key map "p"    'sc-eref-prev)
 574     (define-key map "n"    'sc-eref-next)
 575     (define-key map "s"    'sc-eref-setn)
 576     (define-key map "j"    'sc-eref-jump)
 577     (define-key map "x"    'sc-eref-abort)
 578     (define-key map "q"    'sc-eref-abort)
 579     (define-key map "\r"   'sc-eref-exit)
 580     (define-key map "\n"   'sc-eref-exit)
 581     (define-key map "g"    'sc-eref-goto)
 582     (define-key map "?"    'describe-mode)
 583     (define-key map "\C-h" 'describe-mode)
 584     (define-key map [f1]   'describe-mode)
 585     (define-key map [help] 'describe-mode)
 586     map)
 587   "Keymap for `sc-electric-mode' electric references mode.")
 588
 589
 590 (defvar sc-minibuffer-local-completion-map
 591   (let ((map (copy-keymap minibuffer-local-completion-map)))
 592     (define-key map "\C-t" 'sc-toggle-fn)
 593     (define-key map " "    'self-insert-command)
 594     map)
 595   "Keymap for minibuffer confirmation of attribution strings.")
 596
 597 (defvar sc-minibuffer-local-map
 598   (let ((map (copy-keymap minibuffer-local-map)))
 599     (define-key map "\C-t" 'sc-toggle-fn)
 600     map)
 601   "Keymap for minibuffer confirmation of attribution strings.")
 602
 603 \f
 604 ;; ======================================================================
 605 ;; utility functions
 606
 607 (defun sc-ask (alist)
 608   "Ask a question in the minibuffer requiring a single character answer.
 609 This function is kind of an extension of `y-or-n-p' where a single
 610 letter is used to answer a question.  Question is formed from ALIST
 611 which has members of the form:  (WORD . LETTER).  WORD is the long
 612 word form, while LETTER is the letter for selecting that answer.  The
 613 selected letter is returned, or nil if the question was not answered.
 614 Note that WORD is a string and LETTER is a character.  All LETTERs in
 615 the list should be unique."
 616   (let* ((prompt (concat
 617                   (mapconcat (function (lambda (elt) (car elt))) alist ", ")
 618                   "? ("
 619                   (mapconcat
 620                    (function
 621                     (lambda (elt) (char-to-string (cdr elt)))) alist "/")
 622                   ") "))
 623          (p prompt)
 624          (event
 625           (if (fboundp 'allocate-event)
 626               (allocate-event)
 627             nil)))
 628     (while (stringp p)
 629       (if (let ((cursor-in-echo-area t)
 630                 (inhibit-quit t))
 631             (message "%s" p)
 632             (setq event (read-event))
 633             (prog1 quit-flag (setq quit-flag nil)))
 634           (progn
 635             (message "%s%s" p (single-key-description event))
 636             (and (fboundp 'deallocate-event)
 637                  (deallocate-event event))
 638             (setq quit-flag nil)
 639             (signal 'quit '())))
 640       (let ((char
 641              (if (featurep 'xemacs)
 642                  (let* ((key (and (key-press-event-p event) (event-key event)))
 643                         (char (and key (event-to-character event))))
 644                    char)
 645                event))
 646             elt)
 647         (if char (setq char (downcase char)))
 648         (cond
 649          ((setq elt (rassq char alist))
 650           (message "%s%s" p (car elt))
 651           (setq p (cdr elt)))
 652          ((and (fboundp 'button-release-event-p)
 653                (button-release-event-p event)) ; ignore them
 654           nil)
 655          (t
 656           (message "%s%s" p (single-key-description event))
 657           (if (featurep 'xemacs)
 658               (ding nil 'y-or-n-p)
 659             (ding))
 660           (discard-input)
 661           (if (eq p prompt)
 662               (setq p (concat "Try again.  " prompt)))))))
 663     (and (fboundp 'deallocate-event)
 664          (deallocate-event event))
 665     p))
 666
 667 (defun sc-scan-info-alist (alist)
 668   "Find a match in the info alist that matches a regexp in ALIST."
 669   (let ((sc-mumble "")
 670         rtnvalue)
 671     (while alist
 672       (let* ((elem    (car alist))
 673              (infokey (car elem))
 674              (infoval (sc-mail-field infokey))
 675              (mlist   (car (cdr elem))))
 676         (while mlist
 677           (let* ((ml-elem (car mlist))
 678                  (regexp  (car ml-elem))
 679                  (thing   (cdr ml-elem)))
 680             (if (string-match regexp infoval)
 681                 ;; we found a match, time to return
 682                 (setq rtnvalue thing
 683                       mlist nil
 684                       alist nil)
 685               ;; else we didn't find a match
 686               (setq mlist (cdr mlist))
 687               )))                       ;end of mlist loop
 688         (setq alist (cdr alist))
 689         ))                              ;end of alist loop
 690     rtnvalue))
 691
 692 \f
 693 ;; ======================================================================
 694 ;; extract mail field information from headers in reply buffer
 695
 696 ;; holder variables for bc happiness
 697 (defvar sc-mail-headers-start nil
 698   "Start of header fields.")
 699 (defvar sc-mail-headers-end nil
 700   "End of header fields.")
 701 (defvar sc-mail-field-history nil
 702   "For minibuffer completion on mail field queries.")
 703 (defvar sc-mail-field-modification-history nil
 704   "For minibuffer completion on mail field modifications.")
 705 (defvar sc-mail-glom-frame
 706   '((begin                        (setq sc-mail-headers-start (point)))
 707     ("^x-attribution:[ \t]+.*$"   (sc-mail-fetch-field t) nil t)
 708     ("^\\S +:.*$"                 (sc-mail-fetch-field) nil t)
 709     ("^$"                         (list 'abort '(step . 0)))
 710     ("^[ \t]+"                    (sc-mail-append-field))
 711     (sc-mail-warn-if-non-rfc822-p (sc-mail-error-in-mail-field))
 712     (end                          (setq sc-mail-headers-end (point))))
 713   "Regi frame for glomming mail header information.")
 714
 715 (defvar curline)                        ; dynamic bondage
 716
 717 ;; regi functions
 718 (defun sc-mail-fetch-field (&optional attribs-p)
 719   "Insert a key and value into `sc-mail-info' alist.
 720 If optional ATTRIBS-P is non-nil, the key/value pair is placed in
 721 `sc-attributions' too."
 722   (if (string-match "^\\(\\S *\\)\\s *:\\s +\\(.*\\)$" curline)
 723       (let* ((key (downcase (match-string-no-properties 1 curline)))
 724              (val (match-string-no-properties 2 curline))
 725              (keyval (cons key val)))
 726         (push keyval sc-mail-info)
 727         (if attribs-p
 728             (push keyval sc-attributions))))
 729   nil)
 730
 731 (defun sc-mail-append-field ()
 732   "Append a continuation line onto the last fetched mail field's info."
 733   (let ((keyval (car sc-mail-info)))
 734     (if (and keyval (string-match "^\\s *\\(.*\\)$" curline))
 735         (setcdr keyval (concat (cdr keyval) " "
 736                                (match-string-no-properties 1 curline)))))
 737   nil)
 738
 739 (defun sc-mail-error-in-mail-field ()
 740   "Issue warning that mail headers don't conform to RFC 822."
 741   (let* ((len (min (length curline) 10))
 742          (ellipsis (if (< len (length curline)) "..." ""))
 743          (msg "Mail header \"%s%s\" doesn't conform to RFC 822. skipping..."))
 744     (message msg (substring curline 0 len) ellipsis))
 745   (beep)
 746   (sit-for 2)
 747   nil)
 748
 749 ;; mail header nuking
 750 (defvar sc-mail-last-header-nuked-p nil
 751   "True if the last header was nuked.")
 752
 753 (defun sc-mail-nuke-line ()
 754   "Nuke the current mail header line."
 755   (delete-region (line-beginning-position) (line-beginning-position 2))
 756   '((step . -1)))
 757
 758 (defun sc-mail-nuke-header-line ()
 759   "Delete current-line and set up for possible continuation."
 760   (setq sc-mail-last-header-nuked-p t)
 761   (sc-mail-nuke-line))
 762
 763 (defun sc-mail-nuke-continuation-line ()
 764   "Delete a continuation line if the last header line was deleted."
 765   (if sc-mail-last-header-nuked-p
 766       (sc-mail-nuke-line)))
 767
 768 (defun sc-mail-cleanup-blank-lines ()
 769   "Leave some blank lines after original mail headers are nuked.
 770 The number of lines left is specified by `sc-blank-lines-after-headers'."
 771   (if sc-blank-lines-after-headers
 772       (save-restriction
 773         (widen)
 774         (skip-chars-backward " \t\n")
 775         (forward-line 1)
 776         (delete-blank-lines)
 777         (beginning-of-line)
 778         (if (looking-at "[ \t]*$")
 779             (delete-region (line-beginning-position)
 780                            (line-beginning-position 2)))
 781         (insert-char ?\n sc-blank-lines-after-headers)))
 782   nil)
 783
 784 (defun sc-mail-build-nuke-frame ()
 785   "Build the regiframe for nuking mail headers."
 786   (let (every-func entry-func nonentry-func)
 787     (cond
 788      ((eq sc-nuke-mail-headers 'all)
 789       (setq every-func '(progn (forward-line -1) (sc-mail-nuke-line))))
 790      ((eq sc-nuke-mail-headers 'specified)
 791       (setq entry-func    '(sc-mail-nuke-header-line)
 792             nonentry-func '(setq sc-mail-last-header-nuked-p nil)))
 793      ((eq sc-nuke-mail-headers 'keep)
 794       (setq entry-func    '(setq sc-mail-last-header-nuked-p nil)
 795             nonentry-func '(sc-mail-nuke-header-line)))
 796      ;; we never get far enough to interpret a frame if s-n-m-h == 'none
 797      ((eq sc-nuke-mail-headers 'none))
 798      (t (error "Illegal value for sc-nuke-mail-headers: %s"
 799                sc-nuke-mail-headers))
 800      )                                  ; end-cond
 801     (append
 802      (and entry-func
 803           (regi-mapcar sc-nuke-mail-header-list entry-func nil t))
 804      (and nonentry-func (list (list "^\\S +:.*$" nonentry-func)))
 805      (and (not every-func)
 806           '(("^[ \t]+" (sc-mail-nuke-continuation-line))))
 807      '((begin     (setq sc-mail-last-header-zapped-p nil)))
 808      '((end       (sc-mail-cleanup-blank-lines)))
 809      (and every-func (list (list 'every every-func)))
 810      )))
 811
 812 ;; mail processing and zapping. this is the top level entry defun to
 813 ;; all header processing.
 814 (defun sc-mail-process-headers (start end)
 815   "Process original mail message's mail headers.
 816 After processing, mail headers may be nuked.  Header information is
 817 stored in `sc-mail-info', and any old information is lost unless an
 818 error occurs."
 819   (interactive "r")
 820   (let ((info (copy-alist sc-mail-info))
 821         (attribs (copy-alist sc-attributions)))
 822     (setq sc-mail-info nil
 823           sc-attributions nil)
 824     (regi-interpret sc-mail-glom-frame start end)
 825     (if (null sc-mail-info)
 826         (progn
 827           (message "No mail headers found! Restoring old information.")
 828           (setq sc-mail-info info
 829                 sc-attributions attribs))
 830       (regi-interpret (sc-mail-build-nuke-frame)
 831                       sc-mail-headers-start sc-mail-headers-end)
 832       )))
 833
 834 \f
 835 ;; let the user change mail field information
 836 (defun sc-mail-field (field)
 837   "Return the mail header field value associated with FIELD.
 838 If there was no mail header with FIELD as its key, return the value of
 839 `sc-mumble'.  FIELD is case insensitive."
 840   (or (cdr (assoc (downcase field) sc-mail-info)) sc-mumble))
 841
 842 (defun sc-mail-field-query (arg)
 843   "View the value of a mail field.
 844 With `\\[universal-argument]', prompts for action on mail field.
 845 Action can be one of: View, Modify, Add, or Delete."
 846   (interactive "P")
 847   (let* ((alist '(("view" . ?v) ("modify" . ?m) ("add" . ?a) ("delete" . ?d)))
 848          (action (if (not arg) ?v (sc-ask alist)))
 849          key)
 850     (if (not action)
 851         ()
 852       (setq key (completing-read
 853                  (concat (car (rassq action alist))
 854                               " information key: ")
 855                  sc-mail-info nil
 856                  (if (eq action ?a) nil 'noexit)
 857                  nil 'sc-mail-field-history))
 858       (cond
 859        ((eq action ?v)
 860         (message "%s: %s" key (cdr (assoc key sc-mail-info))))
 861        ((eq action ?d)
 862         (setq sc-mail-info (delq (assoc key sc-mail-info) sc-mail-info)))
 863        ((eq action ?m)
 864         (let ((keyval (assoc key sc-mail-info)))
 865           ;; first put initial value onto list if not already there
 866           (if (not (member (cdr keyval)
 867                            sc-mail-field-modification-history))
 868               (setq sc-mail-field-modification-history
 869                     (cons (cdr keyval) sc-mail-field-modification-history)))
 870           (setcdr keyval (read-string
 871                           (concat key ": ") (cdr keyval)
 872                           'sc-mail-field-modification-history))))
 873        ((eq action ?a)
 874         (push (cons key (read-string (concat key ": "))) sc-mail-info))
 875        ))))
 876
 877 \f
 878 ;; ======================================================================
 879 ;; attributions
 880
 881 (defvar sc-attribution-confirmation-history nil
 882   "History for confirmation of attribution strings.")
 883 (defvar sc-citation-confirmation-history nil
 884   "History for confirmation of attribution prefixes.")
 885
 886 (defun sc-attribs-%@-addresses (from &optional delim)
 887   "Extract the author's email terminus from email address FROM.
 888 Match addresses of the style ``name%[stuff].'' when called with DELIM
 889 of \"%\" and addresses of the style ``[stuff]name@[stuff]'' when
 890 called with DELIM \"@\".  If DELIM is nil or not provided, matches
 891 addresses of the style ``name''."
 892   (and (string-match (concat "[-[:alnum:]_.]+" delim) from 0)
 893        (substring from
 894                   (match-beginning 0)
 895                   (- (match-end 0) (if (null delim) 0 1)))))
 896
 897 (defun sc-attribs-!-addresses (from)
 898   "Extract the author's email terminus from email address FROM.
 899 Match addresses of the style ``[stuff]![stuff]...!name[stuff].''"
 900   (let ((eos (length from))
 901         (mstart (string-match "![-[:alnum:]_.]+\\([^-![:alnum:]_.]\\|$\\)"
 902                               from 0))
 903         (mend (match-end 0)))
 904     (and mstart
 905          (substring from (1+ mstart) (- mend (if (= mend eos) 0 1)))
 906          )))
 907
 908 (defun sc-attribs-<>-addresses (from)
 909   "Extract the author's email terminus from email address FROM.
 910 Match addresses of the style ``<name[stuff]>.''"
 911   (and (string-match "<\\(.*\\)>" from)
 912        (match-string 1 from)))
 913
 914 (defun sc-get-address (from author)
 915   "Get the full email address path from FROM.
 916 AUTHOR is the author's name (which is removed from the address)."
 917   (let ((eos (length from)))
 918     (if (string-match (concat "\\(^\\|^\"\\)" author
 919                               "\\(\\s +\\|\"\\s +\\)") from 0)
 920         (let ((address (substring from (match-end 0) eos)))
 921           (if (and (= (aref address 0) ?<)
 922                    (= (aref address (1- (length address))) ?>))
 923               (substring address 1 (1- (length address)))
 924             address))
 925       (if (string-match "[-[:alnum:]!@%._]+" from 0)
 926           (match-string 0 from)
 927         "")
 928       )))
 929
 930 (defun sc-attribs-emailname (from)
 931   "Get the email terminus name from FROM."
 932   (or
 933    (sc-attribs-%@-addresses from "%")
 934    (sc-attribs-%@-addresses from "@")
 935    (sc-attribs-!-addresses  from)
 936    (sc-attribs-<>-addresses from)
 937    (sc-attribs-%@-addresses from)
 938    (substring from 0 10)))
 939
 940 (defun sc-name-substring (string start end extend)
 941   "Extract the specified substring of STRING from START to END.
 942 EXTEND is the number of characters on each side to extend the
 943 substring."
 944   (and start
 945        (let ((sos (+ start extend))
 946              (eos (- end extend)))
 947          (substring string sos
 948                     (or (string-match sc-titlecue-regexp string sos) eos)
 949                     ))))
 950
 951 (defun sc-attribs-extract-namestring (from)
 952   "Extract the name string from FROM.
 953 This should be the author's full name minus an optional title."
 954   ;; FIXME: we probably should use mail-extract-address-components.
 955   (let ((namestring
 956          (or
 957           ;; If there is a <...> in the name,
 958           ;; treat everything before that as the full name.
 959           ;; Even if it contains parens, use the whole thing.
 960           ;; On the other hand, we do look for quotes in the usual way.
 961           (and (string-match " *<.*>" from 0)
 962                (let ((before-angles
 963                       (sc-name-substring from 0 (match-beginning 0) 0)))
 964                  (if (string-match "\".*\"" before-angles 0)
 965                      (sc-name-substring
 966                       before-angles (match-beginning 0) (match-end 0) 1)
 967                    before-angles)))
 968           (sc-name-substring
 969            from (string-match "(.*)" from 0) (match-end 0) 1)
 970           (sc-name-substring
 971            from (string-match "\".*\"" from 0) (match-end 0) 1)
 972           (sc-name-substring
 973            from (string-match "\\([-.[:alnum:]_]+\\s +\\)+<" from 0)
 974            (match-end 1) 0)
 975           (sc-attribs-emailname from))))
 976     ;; strip off any leading or trailing whitespace
 977     (if namestring
 978         (let ((bos 0)
 979               (eos (1- (length namestring))))
 980           (while (and (<= bos eos)
 981                       (memq (aref namestring bos) '(32 ?\t)))
 982             (setq bos (1+ bos)))
 983           (while (and (> eos bos)
 984                       (memq (aref namestring eos) '(32 ?\t)))
 985             (setq eos (1- eos)))
 986           (substring namestring bos (1+ eos))))))
 987
 988 (defun sc-attribs-chop-namestring (namestring)
 989   "Convert NAMESTRING to a list of names.
 990 example: (sc-attribs-chop-namestring \"John Xavier Doe\")
 991          => (\"John\" \"Xavier\" \"Doe\")"
 992   (if (string-match "\\([ \t]*\\)\\([^ \t._]+\\)\\([ \t]*\\)" namestring)
 993       (cons (match-string 2 namestring)
 994             (sc-attribs-chop-namestring (substring namestring (match-end 3)))
 995             )))
 996
 997 (defun sc-attribs-strip-initials (namelist)
 998   "Extract the author's initials from the NAMELIST."
 999   (mapconcat
1000    (function
1001     (lambda (name)
1002       (if (< 0 (length name))
1003           (substring name 0 1))))
1004    namelist ""))
1005
1006 (defun sc-guess-attribution (&optional string)
1007   "Guess attribution string on current line.
1008 If attribution cannot be guessed, nil is returned.  Optional STRING if
1009 supplied, is used instead of the line point is on in the current buffer."
1010   (let ((start 0)
1011         (string (or string (buffer-substring (line-beginning-position)
1012                                              (line-end-position))))
1013         attribution)
1014     (and
1015      (= start (or (string-match sc-citation-leader-regexp string start) -1))
1016      (setq start (match-end 0))
1017      (= start (or (string-match sc-citation-root-regexp string start) 1))
1018      (setq attribution (match-string 0 string)
1019            start (match-end 0))
1020      (= start (or (string-match sc-citation-delimiter-regexp string start) -1))
1021      (setq start (match-end 0))
1022      (= start (or (string-match sc-citation-separator-regexp string start) -1))
1023      attribution)))
1024
1025 (defun sc-attribs-filter-namelist (namelist)
1026   "Filter out noise in NAMELIST according to `sc-name-filter-alist'."
1027   (let ((elements (length namelist))
1028         (position -1)
1029         keepers filtered-list)
1030     (mapcar
1031      (function
1032       (lambda (name)
1033         (setq position (1+ position))
1034         (let ((keep-p t))
1035           (mapcar
1036            (function
1037             (lambda (filter)
1038               (let ((regexp (car filter))
1039                     (pos (cdr filter)))
1040                 (if (and (string-match regexp name)
1041                          (or (and (numberp pos)
1042                                   (= pos position))
1043                              (and (eq pos 'last)
1044                                   (= position (1- elements)))
1045                              (eq pos 'any)))
1046                     (setq keep-p nil))
1047                 )))
1048            sc-name-filter-alist)
1049           (if keep-p
1050               (setq keepers (cons position keepers)))
1051           )))
1052      namelist)
1053     (mapcar
1054      (function
1055       (lambda (position)
1056         (setq filtered-list (cons (nth position namelist) filtered-list))
1057         ))
1058      keepers)
1059     filtered-list))
1060
1061 (defun sc-attribs-chop-address (from)
1062   "Extract attribution information from FROM.
1063 This populates the `sc-attributions' with the list of possible attributions."
1064   (if (and (stringp from)
1065            (< 0 (length from)))
1066       (let* ((sc-mumble "")
1067              (namestring (sc-attribs-extract-namestring from))
1068              (namelist   (sc-attribs-filter-namelist
1069                           (sc-attribs-chop-namestring namestring)))
1070              (revnames   (reverse (cdr namelist)))
1071              (firstname  (car namelist))
1072              (midnames   (reverse (cdr revnames)))
1073              (lastname   (car revnames))
1074              (initials   (sc-attribs-strip-initials namelist))
1075              (emailname  (sc-attribs-emailname from))
1076              (n 1)
1077              author middlenames)
1078
1079         ;; put basic information
1080         (setq
1081          ;; put middle names and build sc-author entry
1082          middlenames (mapconcat
1083                       (function
1084                        (lambda (midname)
1085                          (let ((key-attribs (format "middlename-%d" n))
1086                                (key-mail    (format "sc-middlename-%d" n)))
1087                            (push (cons key-attribs midname) sc-attributions)
1088                            (push (cons key-mail midname) sc-mail-info)
1089                            (setq n (1+ n))
1090                            midname)))
1091                       midnames " ")
1092
1093          author (concat firstname " " middlenames (and midnames " ") lastname)
1094
1095          sc-attributions (append
1096                           (list
1097                            (cons "firstname"   firstname)
1098                            (cons "lastname"    lastname)
1099                            (cons "emailname"   emailname)
1100                            (cons "initials"    initials))
1101                           sc-attributions)
1102          sc-mail-info (append
1103                        (list
1104                         (cons "sc-firstname"   firstname)
1105                         (cons "sc-middlenames" middlenames)
1106                         (cons "sc-lastname"    lastname)
1107                         (cons "sc-emailname"   emailname)
1108                         (cons "sc-initials"    initials)
1109                         (cons "sc-author"      author)
1110                         (cons "sc-from-address" (sc-get-address
1111                                                  (sc-mail-field "from")
1112                                                  namestring))
1113                         (cons "sc-reply-address" (sc-get-address
1114                                                   (sc-mail-field "reply-to")
1115                                                   namestring))
1116                         (cons "sc-sender-address" (sc-get-address
1117                                                    (sc-mail-field "sender")
1118                                                    namestring))
1119                         )
1120                        sc-mail-info)
1121          ))
1122     ;; from string is empty
1123     (push (cons "sc-author" sc-default-author-name) sc-mail-info)))
1124
1125 (defvar sc-attrib-or-cite nil
1126   "Used to toggle between attribution input or citation input.")
1127
1128 (defun sc-toggle-fn ()
1129   "Toggle between attribution selection and citation selection.
1130 Only used during confirmation."
1131   (interactive)
1132   (setq sc-attrib-or-cite (not sc-attrib-or-cite))
1133   (throw 'sc-reconfirm t))
1134
1135 (defun sc-select-attribution ()
1136   "Select an attribution from `sc-attributions'.
1137
1138 Variables involved in selection process include:
1139      `sc-preferred-attribution-list'
1140      `sc-use-only-preference-p'
1141      `sc-confirm-always-p'
1142      `sc-default-attribution'
1143      `sc-attrib-selection-list'.
1144
1145 Runs the hook `sc-attribs-preselect-hook' before selecting an
1146 attribution and the hook `sc-attribs-postselect-hook' after making the
1147 selection but before querying is performed.  During
1148 `sc-attribs-postselect-hook' the variable `citation' is bound to the
1149 auto-selected citation string and the variable `attribution' is bound
1150 to the auto-selected attribution string."
1151   (run-hooks 'sc-attribs-preselect-hook)
1152   (let ((query-p sc-confirm-always-p)
1153         attribution citation
1154         (attriblist sc-preferred-attribution-list))
1155
1156     ;; first cruise through sc-preferred-attribution-list looking for
1157     ;; a match in either sc-attributions or sc-mail-info.  if the
1158     ;; element is "sc-consult", then we have to do the alist
1159     ;; consultation phase
1160     (while attriblist
1161       (let* ((preferred (car attriblist)))
1162         (cond
1163          ((string= preferred "sc-consult")
1164           ;; we've been told to consult the attribution vs. mail
1165           ;; header key alist.  we do this until we find a match in
1166           ;; the sc-attrib-selection-list.  if we do not find a match,
1167           ;; we continue scanning attriblist
1168           (let ((attrib (sc-scan-info-alist sc-attrib-selection-list)))
1169             (cond
1170              ((not attrib)
1171               (setq attriblist (cdr attriblist)))
1172              ((stringp attrib)
1173               (setq attribution attrib
1174                     attriblist nil))
1175              ((listp attrib)
1176               (setq attribution (eval attrib)
1177                     attriblist nil))
1178              (t (error "%s did not evaluate to a string or list!"
1179                        "sc-attrib-selection-list"))
1180              )))
1181          ((setq attribution (cdr (assoc preferred sc-attributions)))
1182           (setq attriblist nil))
1183          (t
1184           (setq attriblist (cdr attriblist)))
1185          )))
1186
1187     ;; if preference was not found, we may use a secondary method to
1188     ;; find a valid attribution
1189     (if (and (not attribution)
1190              (not sc-use-only-preference-p))
1191         ;; secondary method tries to find a preference in this order
1192         ;; 1. sc-lastchoice
1193         ;; 2. x-attribution
1194         ;; 3. firstname
1195         ;; 4. lastname
1196         ;; 5. initials
1197         ;; 6. first non-empty attribution in alist
1198         (setq attribution
1199               (or (cdr (assoc "sc-lastchoice" sc-attributions))
1200                   (cdr (assoc "x-attribution" sc-attributions))
1201                   (cdr (assoc "firstname" sc-attributions))
1202                   (cdr (assoc "lastname" sc-attributions))
1203                   (cdr (assoc "initials" sc-attributions))
1204                   (cdr (car sc-attributions)))))
1205
1206     ;; still couldn't find an attribution. we're now limited to using
1207     ;; the default attribution, but we'll force a query when this happens
1208     (if (not attribution)
1209         (setq attribution sc-default-attribution
1210               query-p t))
1211
1212     ;; create the attribution prefix
1213     (setq citation (sc-make-citation attribution))
1214
1215     ;; run the post selection hook before querying the user
1216     (run-hooks 'sc-attribs-postselect-hook)
1217
1218     ;; query for confirmation
1219     (if query-p
1220         (let* ((query-alist (mapcar (function (lambda (entry)
1221                                                 (list (cdr entry))))
1222                                     sc-attributions))
1223                (minibuffer-local-completion-map
1224                 sc-minibuffer-local-completion-map)
1225                (minibuffer-local-map sc-minibuffer-local-map)
1226                (initial attribution)
1227                (completer-disable t)    ; in case completer.el is used
1228                choice)
1229           (setq sc-attrib-or-cite nil)  ; nil==attribution, t==citation
1230           (while
1231               (catch 'sc-reconfirm
1232                 (progn
1233                   (setq choice
1234                         (if sc-attrib-or-cite
1235                             (read-string
1236                              "Enter citation prefix: "
1237                              citation
1238                              'sc-citation-confirmation-history)
1239                           (completing-read
1240                            "Complete attribution name: "
1241                            query-alist nil nil
1242                            (cons initial 0)
1243                            'sc-attribution-confirmation-history)
1244                           ))
1245                   nil)))
1246           (if sc-attrib-or-cite
1247               ;; since the citation was chosen, we have to guess at
1248               ;; the attribution
1249               (setq citation choice
1250                     attribution (or (sc-guess-attribution citation)
1251                                     citation))
1252
1253             (setq citation (sc-make-citation choice)
1254                   attribution choice))
1255           ))
1256
1257     ;; its possible that the user wants to downcase the citation and
1258     ;; attribution
1259     (if sc-downcase-p
1260         (setq citation (downcase citation)
1261               attribution (downcase attribution)))
1262
1263     ;; set up mail info alist
1264     (let* ((ckey "sc-citation")
1265            (akey "sc-attribution")
1266            (ckeyval (assoc ckey sc-mail-info))
1267            (akeyval (assoc akey sc-mail-info)))
1268       (if ckeyval
1269           (setcdr ckeyval citation)
1270         (push (cons ckey citation) sc-mail-info))
1271       (if akeyval
1272           (setcdr akeyval attribution)
1273         (push (cons akey attribution) sc-mail-info)))
1274
1275     ;; set the sc-lastchoice attribution
1276     (let* ((lkey "sc-lastchoice")
1277            (lastchoice (assoc lkey sc-attributions)))
1278       (if lastchoice
1279           (setcdr lastchoice attribution)
1280         (push (cons lkey attribution) sc-attributions)))
1281     ))
1282
1283 \f
1284 ;; ======================================================================
1285 ;; filladapt hooks for supercite 3.1. you shouldn't need anything
1286 ;; extra to make gin-mode understand supercited lines.  Even this
1287 ;; stuff might not be entirely necessary...
1288
1289 (defun sc-cite-regexp (&optional root-regexp)
1290   "Return a regexp describing a Supercited line.
1291 The regexp is the concatenation of `sc-citation-leader-regexp',
1292 `sc-citation-root-regexp', `sc-citation-delimiter-regexp', and
1293 `sc-citation-separator-regexp'.  If optional ROOT-REGEXP is supplied,
1294 use it instead of `sc-citation-root-regexp'."
1295   (concat sc-citation-leader-regexp
1296           (or root-regexp sc-citation-root-regexp)
1297           sc-citation-delimiter-regexp
1298           sc-citation-separator-regexp))
1299
1300 (defun sc-make-citation (attribution)
1301   "Make a non-nested citation from ATTRIBUTION."
1302   (concat sc-citation-leader
1303           attribution
1304           sc-citation-delimiter
1305           sc-citation-separator))
1306
1307 (defun sc-setup-filladapt ()
1308   "Setup `filladapt-prefix-table' to handle Supercited paragraphs."
1309   (let* ((fa-sc-elt 'filladapt-supercite-included-text)
1310          (elt (rassq fa-sc-elt filladapt-prefix-table)))
1311     (if elt (setcar elt (sc-cite-regexp))
1312       (message "Filladapt doesn't seem to know about Supercite.")
1313       (beep))))
1314
1315 \f
1316 ;; ======================================================================
1317 ;; citing and unciting regions of text
1318
1319 (defvar sc-fill-begin 1
1320   "Buffer position to begin filling.")
1321 (defvar sc-fill-line-prefix ""
1322   "Fill prefix of previous line")
1323
1324 ;; filling
1325 (defun sc-fill-if-different (&optional prefix)
1326   "Fill the region bounded by `sc-fill-begin' and point.
1327 Only fill if optional PREFIX is different than `sc-fill-line-prefix'.
1328 If `sc-auto-fill-region-p' is nil, do not fill region.  If PREFIX is
1329 not supplied, initialize fill variables.  This is useful for a regi
1330 `begin' frame-entry."
1331   (if (not prefix)
1332       (setq sc-fill-line-prefix ""
1333             sc-fill-begin (line-beginning-position))
1334     (if (and sc-auto-fill-region-p
1335              (not (string= prefix sc-fill-line-prefix)))
1336         (let ((fill-prefix sc-fill-line-prefix))
1337           (if (not (string= fill-prefix ""))
1338               (fill-region sc-fill-begin (line-beginning-position)))
1339           (setq sc-fill-line-prefix prefix
1340                 sc-fill-begin (line-beginning-position))))
1341     )
1342   nil)
1343
1344 (defun sc-cite-coerce-cited-line ()
1345   "Coerce a Supercited line to look like our style."
1346   (let* ((attribution (sc-guess-attribution))
1347          (regexp (sc-cite-regexp attribution))
1348          (prefix (sc-make-citation attribution)))
1349     (if (and attribution
1350              (looking-at regexp))
1351         (progn
1352           (delete-region
1353            (match-beginning 0)
1354            (save-excursion
1355              (goto-char (match-end 0))
1356              (if (bolp) (forward-char -1))
1357              (point)))
1358           (insert prefix)
1359           (sc-fill-if-different prefix)))
1360     nil))
1361
1362 (defun sc-cite-coerce-dumb-citer ()
1363   "Coerce a non-nested citation that's been cited with a dumb nesting citer."
1364   (delete-region (match-beginning 1) (match-end 1))
1365   (beginning-of-line)
1366   (sc-cite-coerce-cited-line))
1367
1368 (defun sc-guess-nesting (&optional string)
1369   "Guess the citation nesting on the current line.
1370 If nesting cannot be guessed, nil is returned.  Optional STRING if
1371 supplied, is used instead of the line point is on in the current
1372 buffer."
1373   (let ((start 0)
1374         (string (or string (buffer-substring (line-beginning-position)
1375                                              (line-end-position))))
1376         nesting)
1377     (and
1378      (= start (or (string-match sc-citation-leader-regexp string start) -1))
1379      (setq start (match-end 0))
1380      (= start (or (string-match sc-citation-delimiter-regexp string start) -1))
1381      (setq nesting (match-string 0 string)
1382            start (match-end 0))
1383      (= start (or (string-match sc-citation-separator-regexp string start) -1))
1384      nesting)))
1385
1386 (defun sc-add-citation-level ()
1387   "Add a citation level for nested citation style w/ coercion."
1388   (let* ((nesting (sc-guess-nesting))
1389          (citation (make-string (1+ (length nesting))
1390                                 (string-to-char sc-citation-delimiter)))
1391          (prefix (concat sc-citation-leader citation sc-citation-separator)))
1392     (if (looking-at (sc-cite-regexp ""))
1393         (delete-region (match-beginning 0) (match-end 0)))
1394     (insert prefix)
1395     (sc-fill-if-different prefix)))
1396
1397 (defun sc-cite-line (&optional citation)
1398   "Cite a single line of uncited text.
1399 Optional CITATION overrides any citation automatically selected."
1400   (if sc-fixup-whitespace-p
1401       (fixup-whitespace))
1402   (let ((prefix (or citation
1403                     (cdr (assoc "sc-citation" sc-mail-info))
1404                     sc-default-attribution)))
1405     (insert prefix)
1406     (sc-fill-if-different prefix))
1407   nil)
1408
1409 (defun sc-uncite-line ()
1410   "Remove citation from current line."
1411   (let ((cited (looking-at (sc-cite-regexp))))
1412     (if cited
1413         (delete-region (match-beginning 0) (match-end 0))))
1414   nil)
1415
1416 (defun sc-recite-line (regexp)
1417   "Remove citation matching REGEXP from current line and recite line."
1418   (let ((cited (looking-at (concat "^" regexp)))
1419         (prefix (cdr (assoc "sc-citation" sc-mail-info))))
1420     (if cited
1421         (delete-region (match-beginning 0) (match-end 0)))
1422     (insert (or prefix sc-default-attribution))
1423     (sc-fill-if-different prefix))
1424   nil)
1425
1426 ;; interactive functions
1427 (defun sc-cite-region (start end &optional confirm-p)
1428   "Cite a region delineated by START and END.
1429 If optional CONFIRM-P is non-nil, the attribution is confirmed before
1430 its use in the citation string.  This function first runs
1431 `sc-pre-cite-hook'."
1432   (interactive "r\nP")
1433   (undo-boundary)
1434   (let ((frame (or (sc-scan-info-alist sc-cite-frame-alist)
1435                    sc-default-cite-frame))
1436         (sc-confirm-always-p (if confirm-p t sc-confirm-always-p)))
1437     (run-hooks 'sc-pre-cite-hook)
1438     (if (interactive-p)
1439         (sc-select-attribution))
1440     (regi-interpret frame start end)))
1441
1442 (defun sc-uncite-region (start end)
1443   "Uncite a region delineated by START and END.
1444 First runs `sc-pre-uncite-hook'."
1445   (interactive "r")
1446   (undo-boundary)
1447   (let ((frame (or (sc-scan-info-alist sc-uncite-frame-alist)
1448                    sc-default-uncite-frame)))
1449     (run-hooks 'sc-pre-uncite-hook)
1450     (regi-interpret frame start end)))
1451
1452 (defun sc-recite-region (start end)
1453   "Recite a region delineated by START and END.
1454 First runs `sc-pre-recite-hook'."
1455   (interactive "r")
1456   (let ((sc-confirm-always-p t))
1457     (sc-select-attribution))
1458   (undo-boundary)
1459   (let ((frame (or (sc-scan-info-alist sc-recite-frame-alist)
1460                    sc-default-recite-frame)))
1461     (run-hooks 'sc-pre-recite-hook)
1462     (regi-interpret frame start end)))
1463
1464 \f
1465 ;; ======================================================================
1466 ;; building headers
1467
1468 (defun sc-hdr (prefix field &optional sep return-nil-p)
1469   "Returns a concatenation of PREFIX and FIELD.
1470 If FIELD is not a string or is the empty string, the empty string will
1471 be returned.  Optional third argument SEP is concatenated on the end if
1472 it is a string.  Returns empty string, unless optional RETURN-NIL-P is
1473 non-nil."
1474   (if (and (stringp field)
1475            (not (string= field "")))
1476       (concat prefix field (or sep ""))
1477     (and (not return-nil-p) "")))
1478
1479 (defun sc-whofrom ()
1480   "Return the value of (sc-mail-field \"from\") or nil."
1481   (let ((sc-mumble nil))
1482     (sc-mail-field "from")))
1483
1484 (defun sc-no-header ()
1485   "Does nothing.  Use this instead of nil to get a blank header."
1486   ())
1487
1488 (defun sc-no-blank-line-or-header()
1489   "Similar to `sc-no-header' except it removes the preceding blank line."
1490   (if (not (bobp))
1491       (if (and (eolp)
1492                (progn (forward-line -1)
1493                       (or (= (point) (mail-header-end))
1494                           (and (eq major-mode 'mh-letter-mode)
1495                                (mh-in-header-p)))))
1496           (progn (forward-line)
1497                  (let ((kill-lines-magic t))
1498                    (kill-line))))))
1499
1500 (defun sc-header-on-said ()
1501   "\"On <date>, <from> said:\" unless:
1502 1. the \"from\" field cannot be found, in which case nothing is inserted;
1503 2. the \"date\" field is missing in which case only the from part is printed."
1504   (let ((sc-mumble "")
1505         (whofrom (sc-whofrom)))
1506     (if whofrom
1507         (insert sc-reference-tag-string
1508                 (sc-hdr "On " (sc-mail-field "date") ", ")
1509                 whofrom " said:\n"))))
1510
1511 (defun sc-header-inarticle-writes ()
1512   "\"In article <message-id>, <from> writes:\"
1513 Treats \"message-id\" and \"from\" fields similar to `sc-header-on-said'."
1514   (let ((sc-mumble "")
1515         (whofrom (sc-mail-field "from")))
1516     (if whofrom
1517         (insert sc-reference-tag-string
1518                 (sc-hdr "In article " (sc-mail-field "message-id") ", ")
1519                 whofrom " writes:\n"))))
1520
1521 (defun sc-header-regarding-adds ()
1522   "\"Regarding <subject>; <from> adds:\"
1523 Treats \"subject\" and \"from\" fields similar to `sc-header-on-said'."
1524   (let ((sc-mumble "")
1525         (whofrom (sc-whofrom)))
1526     (if whofrom
1527         (insert sc-reference-tag-string
1528                 (sc-hdr "Regarding " (sc-mail-field "subject") "; ")
1529                 whofrom " adds:\n"))))
1530
1531 (defun sc-header-attributed-writes ()
1532   "\"<sc-attribution>\" == <sc-author> <address> writes:
1533 Treats these fields in a similar manner to `sc-header-on-said'."
1534   (let ((sc-mumble "")
1535         (whofrom (sc-whofrom)))
1536     (if whofrom
1537         (insert sc-reference-tag-string
1538                 (sc-hdr "\"" (sc-mail-field "sc-attribution") "\" == ")
1539                 (sc-hdr ""   (sc-mail-field "sc-author") " ")
1540                 (or (sc-hdr "<" (sc-mail-field "sc-from-address") ">" t)
1541                     (sc-hdr "<" (sc-mail-field "sc-reply-address") ">"  t)
1542                     "")
1543                 " writes:\n"))))
1544
1545 (defun sc-header-author-writes ()
1546   "<sc-author> writes:"
1547   (let ((sc-mumble "")
1548         (whofrom (sc-whofrom)))
1549     (if whofrom
1550         (insert sc-reference-tag-string
1551                 (sc-hdr "" (sc-mail-field "sc-author"))
1552                 " writes:\n"))))
1553
1554 (defun sc-header-verbose ()
1555   "Very verbose, some say gross."
1556   (let ((sc-mumble "")
1557         (whofrom (sc-whofrom))
1558         (tag sc-reference-tag-string))
1559     (if whofrom
1560         (insert (sc-hdr (concat tag "On ") (sc-mail-field "date") ",\n")
1561                 (or (sc-hdr tag (sc-mail-field "sc-author") "\n" t)
1562                     (concat tag whofrom "\n"))
1563                 (sc-hdr (concat tag "from the organization of ")
1564                         (sc-mail-field "organization") "\n")
1565                 (let ((rtag (concat tag "who can be reached at: ")))
1566                   (or (sc-hdr rtag (sc-mail-field "sc-from-address") "\n" t)
1567                       (sc-hdr rtag (sc-mail-field "sc-reply-address")  "\n" t)
1568                       ""))
1569                 (sc-hdr
1570                  (concat tag "(whose comments are cited below with \"")
1571                  (sc-mail-field "sc-citation") "\"),\n")
1572                 (sc-hdr (concat tag "had this to say in article ")
1573                         (sc-mail-field "message-id") "\n")
1574                 (sc-hdr (concat tag "in newsgroups ")
1575                         (sc-mail-field "newsgroups") "\n")
1576                 (sc-hdr (concat tag "concerning the subject of ")
1577                         (sc-mail-field "subject") "\n")
1578                 (sc-hdr (concat tag "(see ")
1579                         (sc-mail-field "references")
1580                         " for more details)\n")
1581                 ))))
1582
1583 \f
1584 ;; ======================================================================
1585 ;; header rewrites
1586
1587 (defconst sc-electric-bufname " *sc-erefs* "
1588   "Supercite electric reference mode's buffer name.")
1589 (defvar sc-eref-style 0
1590   "Current electric reference style.")
1591
1592 (defun sc-valid-index-p (index)
1593   "Returns INDEX if it is a valid index into `sc-rewrite-header-list'.
1594 Otherwise returns nil."
1595     ;; a number, and greater than or equal to zero
1596     ;; less than or equal to the last index
1597     (and (natnump index)
1598          (< index (length sc-rewrite-header-list))
1599          index))
1600
1601 (defun sc-eref-insert-selected (&optional nomsg)
1602   "Insert the selected reference header in the current buffer.
1603 Optional NOMSG, if non-nil, inhibits printing messages, unless an
1604 error occurs."
1605   (let ((ref (nth sc-eref-style sc-rewrite-header-list)))
1606     (condition-case err
1607         (progn
1608           (eval ref)
1609           (let ((lines (count-lines (point-min) (point-max))))
1610             (or nomsg (message "Ref header %d [%d line%s]: %s"
1611                                sc-eref-style lines
1612                                (if (= lines 1) "" "s")
1613                                ref))))
1614       (void-function
1615        (progn (message
1616                "Symbol's function definition is void: %s (Header %d)"
1617                (car (cdr err)) sc-eref-style)
1618               (beep)
1619               ))
1620       )))
1621
1622 (defun sc-electric-mode (&optional arg)
1623   "
1624 Mode for viewing Supercite reference headers.  Commands are:
1625 \n\\{sc-electric-mode-map}
1626
1627 `sc-electric-mode' is not intended to be run interactively, but rather
1628 accessed through Supercite's electric reference feature.  See
1629 `sc-insert-reference' for more details.  Optional ARG is the initial
1630 header style to use, unless not supplied or invalid, in which case
1631 `sc-preferred-header-style' is used."
1632
1633   (let ((info sc-mail-info))
1634
1635     (setq sc-eref-style
1636           (or (sc-valid-index-p arg)
1637               (sc-valid-index-p sc-preferred-header-style)
1638               0))
1639
1640     (get-buffer-create sc-electric-bufname)
1641     ;; set up buffer and enter command loop
1642     (save-excursion
1643       (save-window-excursion
1644         (pop-to-buffer sc-electric-bufname)
1645         (kill-all-local-variables)
1646         (let ((sc-mail-info info)
1647               (buffer-read-only t)
1648               (mode-name "SC Electric Refs")
1649               (major-mode 'sc-electric-mode))
1650           (use-local-map sc-electric-mode-map)
1651           (sc-eref-show sc-eref-style)
1652           (run-hooks 'sc-electric-mode-hook)
1653           (recursive-edit)
1654           )))
1655
1656     (and sc-eref-style
1657          (sc-eref-insert-selected))
1658     (kill-buffer sc-electric-bufname)
1659     ))
1660
1661 ;; functions for electric reference mode
1662 (defun sc-eref-show (index)
1663   "Show reference INDEX in `sc-rewrite-header-list'."
1664   (let ((msg "No %ing reference headers in list.")
1665         (last (length sc-rewrite-header-list)))
1666     (setq sc-eref-style
1667           (cond
1668            ((sc-valid-index-p index) index)
1669            ((< index 0)
1670             (if sc-electric-circular-p
1671                 (1- last)
1672               (progn (error msg "preced") 0)))
1673            ((>= index last)
1674             (if sc-electric-circular-p
1675                 0
1676               (progn (error msg "follow") (1- last))))
1677            ))
1678     (save-excursion
1679      (set-buffer sc-electric-bufname)
1680      (let ((buffer-read-only nil))
1681        (erase-buffer)
1682        (goto-char (point-min))
1683        (sc-eref-insert-selected)
1684        ;; now shrink the window to just contain the electric reference
1685        ;; header.
1686        (let ((hdrlines (count-lines (point-min) (point-max)))
1687              (winlines (1- (window-height))))
1688          (if (/= hdrlines winlines)
1689              (if (> hdrlines winlines)
1690                  ;; we have to enlarge the window
1691                  (enlarge-window (- hdrlines winlines))
1692                ;; we have to shrink the window
1693                (shrink-window (- winlines (max hdrlines window-min-height)))
1694                )))
1695        ))))
1696
1697 (defun sc-eref-next ()
1698   "Display next reference in other buffer."
1699   (interactive)
1700   (sc-eref-show (1+ sc-eref-style)))
1701
1702 (defun sc-eref-prev ()
1703   "Display previous reference in other buffer."
1704   (interactive)
1705   (sc-eref-show (1- sc-eref-style)))
1706
1707 (defun sc-eref-setn ()
1708   "Set reference header selected as preferred."
1709   (interactive)
1710   (setq sc-preferred-header-style sc-eref-style)
1711   (message "Preferred reference style set to header %d." sc-eref-style))
1712
1713 (defun sc-eref-goto (refnum)
1714   "Show reference style indexed by REFNUM.
1715 If REFNUM is an invalid index, don't go to that reference and return
1716 nil."
1717   (interactive "NGoto Reference: ")
1718   (if (sc-valid-index-p refnum)
1719       (sc-eref-show refnum)
1720     (error "Invalid reference: %d. (Range: [%d .. %d])"
1721            refnum 0 (1- (length sc-rewrite-header-list)))
1722     ))
1723
1724 (defun sc-eref-jump ()
1725   "Set reference header to preferred header."
1726   (interactive)
1727   (sc-eref-show sc-preferred-header-style))
1728
1729 (defun sc-eref-abort ()
1730   "Exit from electric reference mode without inserting reference."
1731   (interactive)
1732   (setq sc-eref-style nil)
1733   (exit-recursive-edit))
1734
1735 (defun sc-eref-exit ()
1736   "Exit from electric reference mode and insert selected reference."
1737   (interactive)
1738   (exit-recursive-edit))
1739
1740 (defun sc-insert-reference (arg)
1741   "Insert, at point, a reference header in the body of the reply.
1742 Numeric ARG indicates which header style from `sc-rewrite-header-list'
1743 to use when rewriting the header.  No supplied ARG indicates use of
1744 `sc-preferred-header-style'.
1745
1746 With just `\\[universal-argument]', electric reference insert mode is
1747 entered, regardless of the value of `sc-electric-references-p'.  See
1748 `sc-electric-mode' for more information."
1749   (interactive "P")
1750   (if (consp arg)
1751       (sc-electric-mode)
1752     (let ((preference (or (sc-valid-index-p arg)
1753                           (sc-valid-index-p sc-preferred-header-style)
1754                           sc-preferred-header-style
1755                           0)))
1756       (if sc-electric-references-p
1757           (sc-electric-mode preference)
1758         (sc-eref-insert-selected t)
1759         ))))
1760
1761 \f
1762 ;; ======================================================================
1763 ;; variable toggling
1764
1765 (defun sc-raw-mode-toggle ()
1766   "Toggle, in one fell swoop, two important SC variables:
1767 `sc-fixup-whitespace-p' and `sc-auto-fill-region-p'"
1768   (interactive)
1769   (setq sc-fixup-whitespace-p (not sc-fixup-whitespace-p)
1770         sc-auto-fill-region-p (not sc-auto-fill-region-p))
1771   (force-mode-line-update))
1772
1773 (defun sc-toggle-var (variable)
1774   "Boolean toggle VARIABLE's value.
1775 VARIABLE must be a bound symbol.  nil values change to t, non-nil
1776 values are changed to nil."
1777   (message "%s changed from %s to %s"
1778            variable (symbol-value variable)
1779            (set variable (not (symbol-value variable)))))
1780
1781 (defun sc-set-variable (var)
1782   "Set the Supercite VARIABLE.
1783 This function mimics `set-variable', except that the variable to set
1784 is determined non-interactively.  The value is queried for in the
1785 minibuffer exactly the same way that `set-variable' does it.
1786
1787 You can see the current value of the variable when the minibuffer is
1788 querying you by typing `C-h'.  Note that the format is changed
1789 slightly from that used by `set-variable' -- the current value is
1790 printed just after the variable's name instead of at the bottom of the
1791 help window."
1792   (let* ((minibuffer-help-form '(funcall myhelp))
1793          (myhelp
1794           (lambda ()
1795             (with-output-to-temp-buffer "*Help*"
1796               (prin1 var)
1797               (if (boundp var)
1798                   (let ((print-length 20))
1799                     (princ "\t(Current value: ")
1800                     (prin1 (symbol-value var))
1801                     (princ ")")))
1802               (princ "\n\nDocumentation:\n")
1803               (princ (substring (documentation-property
1804                                  var
1805                                  'variable-documentation)
1806                                 1))
1807               (with-current-buffer standard-output
1808                 (help-mode))
1809               nil))))
1810     (set var (eval-minibuffer (format "Set %s to value: " var)))))
1811
1812 (defmacro sc-toggle-symbol (rootname)
1813   `(defun ,(intern (concat "sc-T-" rootname)) ()
1814      (interactive)
1815      (sc-toggle-var ',(intern (concat "sc-" rootname "-p")))))
1816
1817 (defmacro sc-setvar-symbol (rootname)
1818   `(defun ,(intern (concat "sc-S-" rootname)) ()
1819      (interactive)
1820      (sc-set-variable ',(intern (concat "sc-" rootname)))))
1821
1822 (sc-toggle-symbol "confirm-always")
1823 (sc-toggle-symbol "downcase")
1824 (sc-toggle-symbol "electric-references")
1825 (sc-toggle-symbol "auto-fill-region")
1826 (sc-toggle-symbol "mail-nuke-blank-lines")
1827 (sc-toggle-symbol "nested-citation")
1828 (sc-toggle-symbol "electric-circular")
1829 (sc-toggle-symbol "use-only-preferences")
1830 (sc-toggle-symbol "fixup-whitespace")
1831
1832 (sc-setvar-symbol "preferred-attribution-list")
1833 (sc-setvar-symbol "preferred-header-style")
1834 (sc-setvar-symbol "mail-nuke-mail-headers")
1835 (sc-setvar-symbol "mail-header-nuke-list")
1836 (sc-setvar-symbol "cite-region-limit")
1837
1838 (defun sc-T-describe ()
1839   "
1840
1841 Supercite provides a number of key bindings which simplify the process
1842 of setting or toggling certain variables controlling its operation.
1843
1844 Note on function names in this list: all functions of the form
1845 `sc-S-<name>' actually call `sc-set-variable' on the corresponding
1846 `sc-<name>' variable.  All functions of the form `sc-T-<name>' call
1847 `sc-toggle-var' on the corresponding `sc-<name>-p' variable.
1848
1849 \\{sc-T-keymap}"
1850   (interactive)
1851   (describe-function 'sc-T-describe))
1852
1853 \f
1854 ;; ======================================================================
1855 ;; published interface to mail and news readers
1856
1857 (define-minor-mode sc-minor-mode
1858   "Supercite minor mode."
1859   nil (" SC" (sc-auto-fill-region-p
1860               (":f" (sc-fixup-whitespace-p "w"))
1861               (sc-fixup-whitespace-p ":w")))
1862   `((,sc-mode-map-prefix . ,sc-mode-map)))
1863
1864 ;;;###autoload
1865 (defun sc-cite-original ()
1866   "Workhorse citing function which performs the initial citation.
1867 This is callable from the various mail and news readers' reply
1868 function according to the agreed upon standard.  See the associated
1869 info node `(SC)Top' for more details.
1870 `sc-cite-original' does not do any yanking of the
1871 original message but it does require a few things:
1872
1873      1) The reply buffer is the current buffer.
1874
1875      2) The original message has been yanked and inserted into the
1876         reply buffer.
1877
1878      3) Verbose mail headers from the original message have been
1879         inserted into the reply buffer directly before the text of the
1880         original message.
1881
1882      4) Point is at the beginning of the verbose headers.
1883
1884      5) Mark is at the end of the body of text to be cited.
1885
1886 For Emacs 19's, the region need not be active (and typically isn't
1887 when this function is called.  Also, the hook `sc-pre-hook' is run
1888 before, and `sc-post-hook' is run after the guts of this function."
1889   (run-hooks 'sc-pre-hook)
1890
1891   (sc-minor-mode 1)
1892
1893   (undo-boundary)
1894
1895   ;; grab point and mark since the region is probably not active when
1896   ;; this function gets automatically called. we want point to be a
1897   ;; mark so any deleting before point works properly
1898   (let* ((zmacs-regions nil)            ; for XEemacs
1899          (mark-active t)                ; for Emacs
1900          (point (point-marker))
1901          (mark  (copy-marker (mark-marker))))
1902
1903     ;; make sure point comes before mark, not all functions are
1904     ;; interactive "r"
1905     (if (< mark point)
1906         (let ((tmp point))
1907           (setq point mark
1908                 mark tmp)))
1909
1910     ;; first process mail headers, and populate sc-mail-info
1911     (sc-mail-process-headers point mark)
1912
1913     ;; now get possible attributions
1914     (sc-attribs-chop-address (or (sc-mail-field "from")
1915                                  (sc-mail-field "reply")
1916                                  (sc-mail-field "reply-to")
1917                                  (sc-mail-field "sender")))
1918     ;; select the attribution
1919     (sc-select-attribution)
1920
1921     ;; cite the region, but first check the value of sc-cite-region-limit
1922     (let ((linecnt (count-lines point mark)))
1923       (and sc-cite-region-limit
1924            (if (or (not (numberp sc-cite-region-limit))
1925                    (<= linecnt sc-cite-region-limit))
1926                (progn
1927                  ;; cite the region and insert the header rewrite
1928                  (sc-cite-region point mark)
1929                  (goto-char point)
1930                  (let ((sc-eref-style (or sc-preferred-header-style 0)))
1931                    (if sc-electric-references-p
1932                        (sc-electric-mode sc-eref-style)
1933                      (sc-eref-insert-selected t))))
1934              (beep)
1935              (message
1936               "Region not cited. %d lines exceeds sc-cite-region-limit: %d"
1937               linecnt sc-cite-region-limit))))
1938
1939     ;; finally, free the point-marker
1940     (set-marker point nil)
1941     (set-marker mark nil)
1942     )
1943   (run-hooks 'sc-post-hook))
1944
1945 \f
1946 ;; ======================================================================
1947 ;; bug reporting and miscellaneous commands
1948
1949 (defun sc-open-line (arg)
1950   "Like `open-line', but insert the citation prefix at the front of the line.
1951 With numeric ARG, inserts that many new lines."
1952   (interactive "p")
1953   (save-excursion
1954     (let ((start (point))
1955           (prefix (or (progn (beginning-of-line)
1956                              (if (looking-at (sc-cite-regexp))
1957                                  (match-string 0)))
1958                       "")))
1959       (goto-char start)
1960       (open-line arg)
1961       (forward-line 1)
1962       (while (< 0 arg)
1963         (insert prefix)
1964         (forward-line 1)
1965         (setq arg (1- arg))
1966         ))))
1967
1968 (defun sc-insert-citation (arg)
1969   "Insert citation string at beginning of current line if not already cited.
1970 With `\\[universal-argument]' insert citation even if line is already
1971 cited."
1972   (interactive "P")
1973   (save-excursion
1974     (beginning-of-line)
1975     (if (or (not (looking-at (sc-cite-regexp)))
1976             (looking-at "^[ \t]*$")
1977             (consp arg))
1978         (insert (sc-mail-field "sc-citation"))
1979       (error "Line is already cited"))))
1980
1981 (defun sc-version (arg)
1982   "Echo the current version of Supercite in the minibuffer.
1983 With \\[universal-argument] (universal-argument), or if run non-interactively,
1984 inserts the version string in the current buffer instead."
1985   (interactive "P")
1986   (let ((verstr (format "Using Supercite.el %s" sc-version)))
1987     (if (or (consp arg)
1988             (not (interactive-p)))
1989         (insert "`sc-version' says: " verstr)
1990       (message verstr))))
1991
1992 (defun sc-describe ()
1993   "
1994 Supercite is a package which provides a flexible mechanism for citing
1995 email and news replies.  Please see the associated texinfo file for
1996 more information.  Info node `(SC)Top'."
1997   (interactive)
1998   (describe-function 'sc-describe))
1999
2000 (defun sc-submit-bug-report ()
2001   "Submit a bug report on Supercite via mail."
2002   (interactive)
2003   (require 'reporter)
2004   (and
2005    (y-or-n-p "Do you want to submit a report on Supercite? ")
2006    (reporter-submit-bug-report
2007     sc-help-address
2008     (concat "Supercite version " sc-version)
2009     (list
2010      'sc-attrib-selection-list
2011      'sc-auto-fill-region-p
2012      'sc-blank-lines-after-headers
2013      'sc-citation-leader
2014      'sc-citation-delimiter
2015      'sc-citation-separator
2016      'sc-citation-leader-regexp
2017      'sc-citation-root-regexp
2018      'sc-citation-nonnested-root-regexp
2019      'sc-citation-delimiter-regexp
2020      'sc-citation-separator-regexp
2021      'sc-cite-region-limit
2022      'sc-confirm-always-p
2023      'sc-default-attribution
2024      'sc-default-author-name
2025      'sc-downcase-p
2026      'sc-electric-circular-p
2027      'sc-electric-references-p
2028      'sc-fixup-whitespace-p
2029      'sc-mail-warn-if-non-rfc822-p
2030      'sc-mumble
2031      'sc-name-filter-alist
2032      'sc-nested-citation-p
2033      'sc-nuke-mail-headers
2034      'sc-nuke-mail-header-list
2035      'sc-preferred-attribution-list
2036      'sc-preferred-header-style
2037      'sc-reference-tag-string
2038      'sc-rewrite-header-list
2039      'sc-titlecue-regexp
2040      'sc-use-only-preference-p
2041      ))))
2042
2043 \f
2044 ;; useful stuff
2045 (provide 'supercite)
2046 (run-hooks 'sc-load-hook)
2047
2048 ;;; arch-tag: a5d5bfa6-3bd5-4414-8c65-0afc83e45cd3
2049 ;;; supercite.el ends here