comparison lisp/mail/supercite.el @ 88155:d7ddb3e565de

sync with trunk

88154:8ce476d3ba36

;;; supercite.el --- minor mode for citing mail and news replies

;; Copyright (C) 1993, 1997 Free Software Foundation, Inc.

;; Author: 1993 Barry A. Warsaw, Century Computing, Inc. <[e-mail]>
;; Maintainer:    Mark Senn <[e-mail]>
;; Created:       February 1993
;; Last Modified: 1993/09/22 18:58:46
;; Keywords: mail, news

;; supercite.el revision: 3.54

;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;; LCD Archive Entry
;; supercite|Barry A. Warsaw|[e-mail]
;; |Mail and news reply citation package
;; |1993/09/22 18:58:46|3.1|

;; start user configuration variables
;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv

(defgroup supercite nil
  "Supercite package"
  :prefix "sc-"
  :group 'mail
  :group 'news)

(defgroup supercite-frames nil
  "Supercite (regi) frames"
  :prefix "sc-"
  :group 'supercite)

(defgroup supercite-attr nil
  "Supercite attributions"
  :prefix "sc-"
  :group 'supercite)

(defgroup supercite-cite nil
  "Supercite citings"
  :prefix "sc-"
  :group 'supercite)

(defgroup supercite-hooks nil
  "Hooking into supercite"
  :prefix "sc-"
  :group 'supercite)

(defcustom sc-auto-fill-region-p t
  "*If non-nil, automatically fill each paragraph after it has been cited."

   (INFOKEY ((REGEXP . FRAME)
             (REGEXP . FRAME)
             (...)))

Where INFOKEY is a key for `sc-mail-field', REGEXP is a regular
expression to match against the INFOKEY's value.  FRAME is a citation
frame, or a variable containing a citation frame."
  :type '(repeat (list symbol (repeat (cons regexp
					    (choice (repeat (repeat sexp))
						    symbol)))))
  :group 'supercite-frames)

(defcustom sc-uncite-frame-alist '()
  "*Alist for frame selection during unciting.
See the variable `sc-cite-frame-alist' for details."
  :type '(repeat (list symbol (repeat (cons regexp
					    (choice (repeat (repeat sexp))
						    symbol)))))
  :group 'supercite-frames)

(defcustom sc-recite-frame-alist '()
  "*Alist for frame selection during reciting.
See the variable `sc-cite-frame-alist' for details."
  :type '(repeat (list symbol (repeat (cons regexp
					    (choice (repeat (repeat sexp))
						    symbol)))))
  :group 'supercite-frames)

(defcustom sc-default-cite-frame
  '(;; initialize fill state and temporary variables when entering
    ;; frame. this makes things run much faster
    (begin (progn

    (end                        (sc-fill-if-different ""))
    )
  "*Default REGI frame for citing a region."
  :type '(repeat (repeat sexp))
  :group 'supercite-frames)

(defcustom sc-default-uncite-frame
  '(;; do nothing on a blank line
    ("^[ \t]*$"       nil)
    ;; if the line is cited, uncite it
    ((sc-cite-regexp) (sc-uncite-line))
    )
  "*Default REGI frame for unciting a region."
  :type '(repeat (repeat sexp))
  :group 'supercite-frames)

(defcustom sc-default-recite-frame
  '(;; initialize fill state when entering frame
    (begin            (sc-fill-if-different))
    ;; do nothing on a blank line

    (end              (sc-fill-if-different ""))
    )
  "*Default REGI frame for reciting a region."
  :type '(repeat (repeat sexp))
  :group 'supercite-frames)

(defcustom sc-cite-region-limit t
  "*This variable controls automatic citation of yanked text.
Legal values are:

non-nil   -- cite the entire region, regardless of its size
nil       -- do not cite the region at all
<integer> -- a number indicating the threshold for citation.  When
	     the number of lines in the region is greater than this

  :type 'boolean
  :group 'supercite)

(defcustom sc-nuke-mail-headers 'all
  "*Controls mail header nuking.
Used in conjunction with `sc-nuke-mail-header-list'.  Legal values are:

`all'       -- nuke all mail headers
`none'      -- don't nuke any mail headers
`specified' -- nuke headers specified in `sc-nuke-mail-header-list'
`keep'      -- keep headers specified in `sc-nuke-mail-header-list'"

  :type '(repeat (list string
		       (repeat (cons regexp
				     (choice (sexp :tag "List to eval")
					     string)))))
  :group 'supercite-attr)

(defcustom sc-attribs-preselect-hook nil
  "*Hook to run before selecting an attribution."
  :type 'hook
  :group 'supercite-attr

The variable `sc-preferred-header-style' controls which function in
this list is chosen for automatic reference header insertions.
Electric reference mode will cycle through this list of functions."
  :type '(repeat sexp)
  :group 'supercite)

(defcustom sc-titlecue-regexp "\\s +-+\\s +"
  "*Regular expression describing the separator between names and titles.
Set to nil to treat entire field as a name."
  :type '(choice (const :tag "entire field as name" nil)

(defvar sc-mail-info nil
  "Alist of mail header information gleaned from reply buffer.")
(defvar sc-attributions nil
  "Alist of attributions for use when citing.")

(defconst sc-emacs-features
  (let ((version 'v18)
	(flavor  'GNU))
    (if (not
	 (string= (substring emacs-version 0 2) "18"))
	(setq version 'v19))
    (if (string-match "Lucid" emacs-version)
	(setq flavor 'Lucid))
    ;; cobble up list
    (list version flavor))
  "A list describing what version of Emacs we're running on.
Known flavors are:

Emacs 18           : (v18 GNU)
Emacs 19 or later  : (v19 GNU)
Lucid 19 or later  : (v19 Lucid)")


(defvar sc-tmp-nested-regexp nil
  "Temporary regepx describing nested citations.")
(defvar sc-tmp-nonnested-regexp nil
  "Temporary regexp describing non-nested citations.")
(defvar sc-tmp-dumb-regexp nil
  "Temp regexp describing non-nested citation cited with a nesting citer.")

(defvar sc-minor-mode nil
  "Supercite minor mode on flag.")
(defvar sc-mode-string " SC"
  "Supercite minor mode string.")

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

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

(defvar sc-mode-map-prefix "\C-c\C-p"
  "*Key binding to install Supercite keymap.
If this is nil, Supercite keymap is not installed.")

(defvar sc-T-keymap ()
  "Keymap for sub-keymap of setting and toggling functions.")
(if sc-T-keymap
    ()
  (setq sc-T-keymap (make-sparse-keymap))
  (define-key sc-T-keymap "a" 'sc-S-preferred-attribution-list)
  (define-key sc-T-keymap "b" 'sc-T-mail-nuke-blank-lines)
  (define-key sc-T-keymap "c" 'sc-T-confirm-always)
  (define-key sc-T-keymap "d" 'sc-T-downcase)
  (define-key sc-T-keymap "e" 'sc-T-electric-references)
  (define-key sc-T-keymap "f" 'sc-T-auto-fill-region)
  (define-key sc-T-keymap "h" 'sc-T-describe)
  (define-key sc-T-keymap "l" 'sc-S-cite-region-limit)
  (define-key sc-T-keymap "n" 'sc-S-mail-nuke-mail-headers)
  (define-key sc-T-keymap "N" 'sc-S-mail-header-nuke-list)
  (define-key sc-T-keymap "o" 'sc-T-electric-circular)
  (define-key sc-T-keymap "p" 'sc-S-preferred-header-style)
  (define-key sc-T-keymap "s" 'sc-T-nested-citation)
  (define-key sc-T-keymap "u" 'sc-T-use-only-preferences)
  (define-key sc-T-keymap "w" 'sc-T-fixup-whitespace)
  (define-key sc-T-keymap "?" 'sc-T-describe)
  )

(defvar sc-mode-map ()
  "Keymap for Supercite quasi-mode.")
(if sc-mode-map
    ()
  (setq sc-mode-map (make-sparse-keymap))
  (define-key sc-mode-map "c"    'sc-cite-region)
  (define-key sc-mode-map "f"    'sc-mail-field-query)
  (define-key sc-mode-map "g"    'sc-mail-process-headers)
  (define-key sc-mode-map "h"    'sc-describe)
  (define-key sc-mode-map "i"    'sc-insert-citation)
  (define-key sc-mode-map "o"    'sc-open-line)
  (define-key sc-mode-map "r"    'sc-recite-region)
  (define-key sc-mode-map "\C-p" 'sc-raw-mode-toggle)
  (define-key sc-mode-map "u"    'sc-uncite-region)
  (define-key sc-mode-map "v"    'sc-version)
  (define-key sc-mode-map "w"    'sc-insert-reference)
  (define-key sc-mode-map "\C-t"  sc-T-keymap)
  (define-key sc-mode-map "\C-b" 'sc-submit-bug-report)
  (define-key sc-mode-map "?"    'sc-describe)
  )

(defvar sc-electric-mode-map ()
  "Keymap for `sc-electric-mode' electric references mode.")
(if sc-electric-mode-map
    nil
  (setq sc-electric-mode-map (make-sparse-keymap))
  (define-key sc-electric-mode-map "p"    'sc-eref-prev)
  (define-key sc-electric-mode-map "n"    'sc-eref-next)
  (define-key sc-electric-mode-map "s"    'sc-eref-setn)
  (define-key sc-electric-mode-map "j"    'sc-eref-jump)
  (define-key sc-electric-mode-map "x"    'sc-eref-abort)
  (define-key sc-electric-mode-map "q"    'sc-eref-abort)
  (define-key sc-electric-mode-map "\r"   'sc-eref-exit)
  (define-key sc-electric-mode-map "\n"   'sc-eref-exit)
  (define-key sc-electric-mode-map "g"    'sc-eref-goto)
  (define-key sc-electric-mode-map "?"    'describe-mode)
  (define-key sc-electric-mode-map "\C-h" 'describe-mode)
  (define-key sc-electric-mode-map [f1]   'describe-mode)
  (define-key sc-electric-mode-map [help] 'describe-mode)
  )

(defvar sc-minibuffer-local-completion-map nil
  "Keymap for minibuffer confirmation of attribution strings.")
(if sc-minibuffer-local-completion-map
    ()
  (setq sc-minibuffer-local-completion-map
	(copy-keymap minibuffer-local-completion-map))
  (define-key sc-minibuffer-local-completion-map "\C-t" 'sc-toggle-fn)
  (define-key sc-minibuffer-local-completion-map " "    'self-insert-command))

(defvar sc-minibuffer-local-map nil
  "Keymap for minibuffer confirmation of attribution strings.")
(if sc-minibuffer-local-map
    ()
  (setq sc-minibuffer-local-map (copy-keymap minibuffer-local-map))
  (define-key sc-minibuffer-local-map "\C-t" 'sc-toggle-fn))

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

(defun sc-completing-read (prompt table &optional predicate require-match
				  initial-contents history)
  "Compatibility between Emacs 18 and 19 `completing-read'.
In version 18, the HISTORY argument is ignored."
  (if (memq 'v19 sc-emacs-features)
      (funcall 'completing-read prompt table predicate require-match
	       initial-contents history)
    (funcall 'completing-read prompt table predicate require-match
	     (or (car-safe initial-contents)
		 initial-contents))))

(defun sc-read-string (prompt &optional initial-contents history)
  "Compatibility between Emacs 18 and 19 `read-string'.
In version 18, the HISTORY argument is ignored."
  (if (memq 'v19 sc-emacs-features)
      (read-string prompt initial-contents history)
    (read-string prompt initial-contents)))

(if (fboundp 'match-string)
    (defalias 'sc-submatch 'match-string)
  (defun sc-submatch (matchnum &optional string)
    "Returns `match-beginning' and `match-end' sub-expression for MATCHNUM.
If optional STRING is provided, take sub-expression using `substring'
of argument, otherwise use `buffer-substring' on current buffer.  Note
that `match-data' must have already been generated and no error
checking is performed by this function."
    (if string
	(substring string (match-beginning matchnum) (match-end matchnum))
      (buffer-substring (match-beginning matchnum) (match-end matchnum)))))

(if (fboundp 'member)
    (defalias 'sc-member 'member)
  (defun sc-member (elt list)
    "Like `memq', but uses `equal' instead of `eq'.
Emacs19 has a builtin function `member' which does exactly this."
    (catch 'elt-is-member
      (while list
	(if (equal elt (car list))
	    (throw 'elt-is-member list))
	(setq list (cdr list))))))

;; One day maybe Emacs will have this...
(if (fboundp 'string-text)
    (defalias 'sc-string-text 'string-text)
  (defun sc-string-text (string)
    "Return STRING with all text properties removed."
    (let ((string (copy-sequence string)))
      (set-text-properties 0 (length string) nil string)
      string)))

(defun sc-ask (alist)
  "Ask a question in the minibuffer requiring a single character answer.
This function is kind of an extension of `y-or-n-p' where a single
letter is used to answer a question.  Question is formed from ALIST

		   (function
		    (lambda (elt) (char-to-string (cdr elt)))) alist "/")
		  ") "))
	 (p prompt)
	 (event
	  (if (memq 'Lucid sc-emacs-features)
	      (allocate-event)
	    nil)))
    (while (stringp p)
      (if (let ((cursor-in-echo-area t)
		(inhibit-quit t))
	    (message "%s" p)
	    ;; lets be good neighbors and be compatible with all emacsen
	    (cond
	     ((memq 'v18 sc-emacs-features)
	      (setq event (read-char)))
	     ((memq 'Lucid sc-emacs-features)
	      (next-command-event event))
	     (t				; must be Emacs 19
	      (setq event (read-event))))
	    (prog1 quit-flag (setq quit-flag nil)))
	  (progn
	    (message "%s%s" p (single-key-description event))
	    (and (memq 'Lucid sc-emacs-features)
		 (deallocate-event event))
	    (setq quit-flag nil)
	    (signal 'quit '())))
      (let ((char
	     (if (memq 'Lucid sc-emacs-features)
		 (let* ((key (and (key-press-event-p event) (event-key event)))
			(char (and key (event-to-character event))))
		   char)
	       event))
	    elt)
	(if char (setq char (downcase char)))
	(cond
	 ((setq elt (rassq char alist))
	  (message "%s%s" p (car elt))
	  (setq p (cdr elt)))
	 ((and (memq 'Lucid sc-emacs-features)
	       (button-release-event-p event)) ; ignore them
	  nil)
	 (t
	  (message "%s%s" p (single-key-description event))
	  (if (memq 'Lucid sc-emacs-features)
	      (ding nil 'y-or-n-p)
	    (ding))
	  (discard-input)
	  (if (eq p prompt)
	      (setq p (concat "Try again.  " prompt)))))))
    (and (memq 'Lucid sc-emacs-features)
	 (deallocate-event event))
    p))

(defun sc-scan-info-alist (alist)
  "Find a match in the info alist that matches a regexp in ALIST."
  (let ((sc-mumble "")

    ("^$"                         (list 'abort '(step . 0)))
    ("^[ \t]+"                    (sc-mail-append-field))
    (sc-mail-warn-if-non-rfc822-p (sc-mail-error-in-mail-field))
    (end                          (setq sc-mail-headers-end (point))))
  "Regi frame for glomming mail header information.")

(eval-when-compile (defvar curline))	; dynamic bondage

;; regi functions
(defun sc-mail-fetch-field (&optional attribs-p)
  "Insert a key and value into `sc-mail-info' alist.
If optional ATTRIBS-P is non-nil, the key/value pair is placed in
`sc-attributions' too."
  (if (string-match "^\\(\\S *\\)\\s *:\\s +\\(.*\\)$" curline)
      (let* ((key (downcase (sc-string-text (sc-submatch 1 curline))))
	     (val (sc-string-text (sc-submatch 2 curline)))
	     (keyval (cons key val)))
	(setq sc-mail-info (cons keyval sc-mail-info))
	(if attribs-p
	    (setq sc-attributions (cons keyval sc-attributions)))
	))
  nil)

(defun sc-mail-append-field ()
  "Append a continuation line onto the last fetched mail field's info."
  (let ((keyval (car sc-mail-info)))
    (if (and keyval (string-match "^\\s *\\(.*\\)$" curline))
	(setcdr keyval (concat (cdr keyval) " "
			       (sc-string-text (sc-submatch 1 curline))))))
  nil)

(defun sc-mail-error-in-mail-field ()
  "Issue warning that mail headers don't conform to RFC 822."
  (let* ((len (min (length curline) 10))

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

(defun sc-mail-nuke-line ()
  "Nuke the current mail header line."
  (delete-region (regi-pos 'bol) (regi-pos 'bonl))
  '((step . -1)))

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

	(skip-chars-backward " \t\n")
	(forward-line 1)
	(delete-blank-lines)
	(beginning-of-line)
	(if (looking-at "[ \t]*$")
	    (delete-region (regi-pos 'bol) (regi-pos 'bonl)))
	(insert-char ?\n sc-blank-lines-after-headers)))
  nil)

(defun sc-mail-build-nuke-frame ()
  "Build the regiframe for nuking mail headers."

     ((eq sc-nuke-mail-headers 'keep)
      (setq entry-func    '(setq sc-mail-last-header-nuked-p nil)
	    nonentry-func '(sc-mail-nuke-header-line)))
     ;; we never get far enough to interpret a frame if s-n-m-h == 'none
     ((eq sc-nuke-mail-headers 'none))
     (t (error "Illegal value for sc-nuke-mail-headers: %s"
	       sc-nuke-mail-headers))
     )					; end-cond
    (append
     (and entry-func
	  (regi-mapcar sc-nuke-mail-header-list entry-func nil t))

;; let the user change mail field information
(defun sc-mail-field (field)
  "Return the mail header field value associated with FIELD.
If there was no mail header with FIELD as its key, return the value of
`sc-mumble'.  FIELD is case insensitive."
  (or (cdr (assoc (downcase field) sc-mail-info)) sc-mumble))

(defun sc-mail-field-query (arg)
  "View the value of a mail field.
With `\\[universal-argument]', prompts for action on mail field.
Action can be one of: View, Modify, Add, or Delete."

  (let* ((alist '(("view" . ?v) ("modify" . ?m) ("add" . ?a) ("delete" . ?d)))
	 (action (if (not arg) ?v (sc-ask alist)))
	 key)
    (if (not action)
	()
      (setq key (sc-completing-read
		 (concat (car (rassq action alist))
			      " information key: ")
		 sc-mail-info nil
		 (if (eq action ?a) nil 'noexit)
		 nil 'sc-mail-field-history))

       ((eq action ?d)
	(setq sc-mail-info (delq (assoc key sc-mail-info) sc-mail-info)))
       ((eq action ?m)
	(let ((keyval (assoc key sc-mail-info)))
	  ;; first put initial value onto list if not already there
	  (if (not (sc-member (cdr keyval)
			      sc-mail-field-modification-history))
	      (setq sc-mail-field-modification-history
		    (cons (cdr keyval) sc-mail-field-modification-history)))
	  (setcdr keyval (sc-read-string
			  (concat key ": ") (cdr keyval)
			  'sc-mail-field-modification-history))))
       ((eq action ?a)
	(setq sc-mail-info
	      (cons (cons key
			  (sc-read-string (concat key ": "))) sc-mail-info)))
       ))))

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

  "Extract the author's email terminus from email address FROM.
Match addresses of the style ``name%[stuff].'' when called with DELIM
of \"%\" and addresses of the style ``[stuff]name@[stuff]'' when
called with DELIM \"@\".  If DELIM is nil or not provided, matches
addresses of the style ``name''."
  (and (string-match (concat "[-a-zA-Z0-9_.]+" delim) from 0)
       (substring from
		  (match-beginning 0)
		  (- (match-end 0) (if (null delim) 0 1)))))

(defun sc-attribs-!-addresses (from)
  "Extract the author's email terminus from email address FROM.
Match addresses of the style ``[stuff]![stuff]...!name[stuff].''"
  (let ((eos (length from))
	(mstart (string-match "![-a-zA-Z0-9_.]+\\([^-!a-zA-Z0-9_.]\\|$\\)"
			      from 0))
	(mend (match-end 0)))
    (and mstart
	 (substring from (1+ mstart) (- mend (if (= mend eos) 0 1)))
	 )))

(defun sc-attribs-<>-addresses (from)
  "Extract the author's email terminus from email address FROM.
Match addresses of the style ``<name[stuff]>.''"
  (and (string-match "<\\(.*\\)>" from)
       (sc-submatch 1 from)))

(defun sc-get-address (from author)
  "Get the full email address path from FROM.
AUTHOR is the author's name (which is removed from the address)."
  (let ((eos (length from)))
    (if (string-match (concat "\\(^\\|^\"\\)" author
			      "\\(\\s +\\|\"\\s +\\)") from 0)
	(let ((address (substring from (match-end 0) eos)))
	  (if (and (= (aref address 0) ?<)
		   (= (aref address (1- (length address))) ?>))
	      (substring address 1 (1- (length address)))
	    address))
      (if (string-match "[-[:alnum:]!@%._]+" from 0)
	  (sc-submatch 0 from)
	"")
      )))

(defun sc-attribs-emailname (from)
  "Get the email terminus name from FROM."

		    ))))

(defun sc-attribs-extract-namestring (from)
  "Extract the name string from FROM.
This should be the author's full name minus an optional title."
  (let ((namestring
	 (or
	  ;; If there is a <...> in the name,
	  ;; treat everything before that as the full name.
	  ;; Even if it contains parens, use the whole thing.

	    (setq eos (1- eos)))
	  (substring namestring bos (1+ eos))))))

(defun sc-attribs-chop-namestring (namestring)
  "Convert NAMESTRING to a list of names.
example: (sc-namestring-to-list \"John Xavier Doe\")
         => (\"John\" \"Xavier\" \"Doe\")"
  (if (string-match "\\([ \t]*\\)\\([^ \t._]+\\)\\([ \t]*\\)" namestring)
      (cons (sc-submatch 2 namestring)
	    (sc-attribs-chop-namestring (substring namestring (match-end 3)))
	    )))

(defun sc-attribs-strip-initials (namelist)
  "Extract the author's initials from the NAMELIST."

(defun sc-guess-attribution (&optional string)
  "Guess attribution string on current line.
If attribution cannot be guessed, nil is returned.  Optional STRING if
supplied, is used instead of the line point is on in the current buffer."
  (let ((start 0)
	(string (or string (buffer-substring (regi-pos 'bol) (regi-pos 'eol))))
	attribution)
    (and
     (= start (or (string-match sc-citation-leader-regexp string start) -1))
     (setq start (match-end 0))
     (= start (or (string-match sc-citation-root-regexp string start) 1))
     (setq attribution (sc-submatch 0 string)
	   start (match-end 0))
     (= start (or (string-match sc-citation-delimiter-regexp string start) -1))
     (setq start (match-end 0))
     (= start (or (string-match sc-citation-separator-regexp string start) -1))
     attribution)))

	 middlenames (mapconcat
		      (function
		       (lambda (midname)
			 (let ((key-attribs (format "middlename-%d" n))
			       (key-mail    (format "sc-middlename-%d" n)))
			   (setq
			    sc-attributions (cons (cons key-attribs midname)
						  sc-attributions)
			    sc-mail-info (cons (cons key-mail midname)
					       sc-mail-info)
			    n (1+ n))
			   midname)))
		      midnames " ")

	 author (concat firstname " " middlenames (and midnames " ") lastname)

						   namestring))
			)
		       sc-mail-info)
	 ))
    ;; from string is empty
    (setq sc-mail-info (cons (cons "sc-author" sc-default-author-name)
			     sc-mail-info))))

(defvar sc-attrib-or-cite nil
  "Used to toggle between attribution input or citation input.")

(defun sc-toggle-fn ()

	      (setq attriblist (cdr attriblist)))
	     ((stringp attrib)
	      (setq attribution attrib
		    attriblist nil))
	     ((listp attrib)
	      (setq attribution (eval attrib)
		    attriblist nil))
	     (t (error "%s did not evaluate to a string or list!"
		       "sc-attrib-selection-list"))
	     )))
	 ((setq attribution (cdr (assoc preferred sc-attributions)))
	  (setq attriblist nil))

	  (while
	      (catch 'sc-reconfirm
		(progn
		  (setq choice
			(if sc-attrib-or-cite
			    (sc-read-string
			     "Enter citation prefix: "
			     citation
			     'sc-citation-confirmation-history)
			  (sc-completing-read
			   "Complete attribution name: "
			   query-alist nil nil
			   (cons initial 0)
			   'sc-attribution-confirmation-history)
			  ))

	   (akey "sc-attribution")
	   (ckeyval (assoc ckey sc-mail-info))
	   (akeyval (assoc akey sc-mail-info)))
      (if ckeyval
	  (setcdr ckeyval citation)
	(setq sc-mail-info
	      (append (list (cons ckey citation)) sc-mail-info)))
      (if akeyval
	  (setcdr akeyval attribution)
	(setq sc-mail-info
	      (append (list (cons akey attribution)) sc-mail-info))))

    ;; set the sc-lastchoice attribution
    (let* ((lkey "sc-lastchoice")
	   (lastchoice (assoc lkey sc-attributions)))
      (if lastchoice
	  (setcdr lastchoice attribution)
	(setq sc-attributions
	      (cons (cons lkey attribution) sc-attributions))))
    ))


;; ======================================================================
;; filladapt hooks for supercite 3.1. you shouldn't need anything

  (concat sc-citation-leader
	  attribution
	  sc-citation-delimiter
	  sc-citation-separator))

(defun sc-setup-filladapt ()
  "Setup `filladapt-prefix-table' to handle Supercited paragraphs."
  (let* ((fa-sc-elt 'filladapt-supercite-included-text)
	 (elt (rassq fa-sc-elt filladapt-prefix-table)))
    (if elt (setcar elt (sc-cite-regexp))

If `sc-auto-fill-region-p' is nil, do not fill region.  If PREFIX is
not supplied, initialize fill variables.  This is useful for a regi
`begin' frame-entry."
  (if (not prefix)
      (setq sc-fill-line-prefix ""
	    sc-fill-begin (regi-pos 'bol))
    (if (and sc-auto-fill-region-p
	     (not (string= prefix sc-fill-line-prefix)))
	(let ((fill-prefix sc-fill-line-prefix))
	  (if (not (string= fill-prefix ""))
	      (fill-region sc-fill-begin (regi-pos 'bol)))
	  (setq sc-fill-line-prefix prefix
		sc-fill-begin (regi-pos 'bol))))
    )
  nil)

(defun sc-cite-coerce-cited-line ()
  "Coerce a Supercited line to look like our style."

  "Guess the citation nesting on the current line.
If nesting cannot be guessed, nil is returned.  Optional STRING if
supplied, is used instead of the line point is on in the current
buffer."
  (let ((start 0)
	(string (or string (buffer-substring (regi-pos 'bol) (regi-pos 'eol))))
	nesting)
    (and
     (= start (or (string-match sc-citation-leader-regexp string start) -1))
     (setq start (match-end 0))
     (= start (or (string-match sc-citation-delimiter-regexp string start) -1))
     (setq nesting (sc-submatch 0 string)
	   start (match-end 0))
     (= start (or (string-match sc-citation-separator-regexp string start) -1))
     nesting)))

(defun sc-add-citation-level ()

    (insert (or prefix sc-default-attribution))
    (sc-fill-if-different prefix))
  nil)

;; interactive functions
(defun sc-cite-region (start end &optional confirm-p)
  "Cite a region delineated by START and END.
If optional CONFIRM-P is non-nil, the attribution is confirmed before
its use in the citation string.  This function first runs
`sc-pre-cite-hook'."
  (interactive "r\nP")
  (undo-boundary)
  (let ((frame (or (sc-scan-info-alist sc-cite-frame-alist)
		   sc-default-cite-frame))
	(sc-confirm-always-p (if confirm-p t sc-confirm-always-p)))
    (run-hooks 'sc-pre-cite-hook)
    (if (interactive-p)
	(sc-select-attribution))
    (regi-interpret frame start end)))

(defun sc-uncite-region (start end)
  "Uncite a region delineated by START and END.
First runs `sc-pre-uncite-hook'."
  (interactive "r")
  (undo-boundary)
  (let ((frame (or (sc-scan-info-alist sc-uncite-frame-alist)
		   sc-default-uncite-frame)))
    (run-hooks 'sc-pre-uncite-hook)
    (regi-interpret frame start end)))

(defun sc-recite-region (start end)
  "Recite a region delineated by START and END.
First runs `sc-pre-recite-hook'."
  (interactive "r")
  (let ((sc-confirm-always-p t))
    (sc-select-attribution))
  (undo-boundary)
  (let ((frame (or (sc-scan-info-alist sc-recite-frame-alist)
		   sc-default-recite-frame)))
    (run-hooks 'sc-pre-recite-hook)
    (regi-interpret frame start end)))


;; ======================================================================

  (if (not (bobp))
      (if (and (eolp)
	       (progn (forward-line -1)
		      (or (= (point) (mail-header-end))
			  (and (eq major-mode 'mh-letter-mode)
			       (mh-in-header-p)))))
	  (progn (forward-line)
		 (let ((kill-lines-magic t))
		   (kill-line))))))

(defun sc-header-on-said ()

	      (buffer-read-only t)
	      (mode-name "SC Electric Refs")
	      (major-mode 'sc-electric-mode))
	  (use-local-map sc-electric-mode-map)
	  (sc-eref-show sc-eref-style)
	  (run-hooks 'sc-electric-mode-hook)
	  (recursive-edit)
	  )))

    (and sc-eref-style
	 (sc-eref-insert-selected))

  "Toggle, in one fell swoop, two important SC variables:
`sc-fixup-whitespace-p' and `sc-auto-fill-region-p'"
  (interactive)
  (setq sc-fixup-whitespace-p (not sc-fixup-whitespace-p)
	sc-auto-fill-region-p (not sc-auto-fill-region-p))
  (sc-set-mode-string)
  (force-mode-line-update))

(defun sc-toggle-var (variable)
  "Boolean toggle VARIABLE's value.
VARIABLE must be a bound symbol.  nil values change to t, non-nil
values are changed to nil."
  (message "%s changed from %s to %s"
	   variable (symbol-value variable)
	   (set variable (not (symbol-value variable))))
  (sc-set-mode-string))

(defun sc-set-variable (var)
  "Set the Supercite VARIABLE.
This function mimics `set-variable', except that the variable to set
is determined non-interactively.  The value is queried for in the

You can see the current value of the variable when the minibuffer is
querying you by typing `C-h'.  Note that the format is changed
slightly from that used by `set-variable' -- the current value is
printed just after the variable's name instead of at the bottom of the
help window."
  (let* ((minibuffer-help-form
	  '(funcall myhelp))
	 (myhelp
	  (function
	   (lambda ()
	     (with-output-to-temp-buffer "*Help*"
	       (prin1 var)
	       (if (boundp var)
		   (let ((print-length 20))
		     (princ "\t(Current value: ")
		     (prin1 (symbol-value var))
		     (princ ")")))
	       (princ "\n\nDocumentation:\n")
	       (princ (substring (documentation-property
				  var
				  'variable-documentation)
				  1))
	       (save-excursion
		 (set-buffer standard-output)
		 (help-mode))
	       nil)))))
    (set var (eval-minibuffer (format "Set %s to value: " var))))
  (sc-set-mode-string))

(defmacro sc-toggle-symbol (rootname)
  (list 'defun (intern (concat "sc-T-" rootname)) '()
	(list 'interactive)
	(list 'sc-toggle-var
	      (list 'quote (intern (concat "sc-" rootname "-p"))))))

(defmacro sc-setvar-symbol (rootname)
  (list 'defun (intern (concat "sc-S-" rootname)) '()
	(list 'interactive)
	(list 'sc-set-variable
	      (list 'quote (intern (concat "sc-" rootname))))))

(sc-toggle-symbol "confirm-always")
(sc-toggle-symbol "downcase")
(sc-toggle-symbol "electric-references")
(sc-toggle-symbol "auto-fill-region")

\\{sc-T-keymap}"
  (interactive)
  (describe-function 'sc-T-describe))

(defun sc-set-mode-string ()
  "Update the minor mode string to show state of Supercite."
  (setq sc-mode-string
	(concat " SC"
		(if (or sc-auto-fill-region-p
			sc-fixup-whitespace-p)
		    ":" "")
		(if sc-auto-fill-region-p "f" "")
		(if sc-fixup-whitespace-p "w" "")
		)))


;; ======================================================================
;; published interface to mail and news readers

;;;###autoload
(defun sc-cite-original ()
  "Workhorse citing function which performs the initial citation.
This is callable from the various mail and news readers' reply
function according to the agreed upon standard.  See `\\[sc-describe]'
for more details.  `sc-cite-original' does not do any yanking of the
original message but it does require a few things:

     1) The reply buffer is the current buffer.

     2) The original message has been yanked and inserted into the

For Emacs 19's, the region need not be active (and typically isn't
when this function is called.  Also, the hook `sc-pre-hook' is run
before, and `sc-post-hook' is run after the guts of this function."
  (run-hooks 'sc-pre-hook)

  ;; before we do anything, we want to insert the supercite keymap so
  ;; we can proceed from here
  (and sc-mode-map-prefix
       (local-set-key sc-mode-map-prefix sc-mode-map))

  ;; hack onto the minor mode alist, if it hasn't been done before,
  ;; then turn on the minor mode. also, set the minor mode string with
  ;; the values of fill and fixup whitespace variables
  (if (not (get 'minor-mode-alist 'sc-minor-mode))
      (progn
	(put 'minor-mode-alist 'sc-minor-mode 'sc-minor-mode)
	(setq minor-mode-alist
	      (cons '(sc-minor-mode sc-mode-string) minor-mode-alist))
	))
  (setq sc-minor-mode t)
  (sc-set-mode-string)

  (undo-boundary)

  ;; grab point and mark since the region is probably not active when
  ;; this function gets automatically called. we want point to be a
  ;; mark so any deleting before point works properly
  (let* ((zmacs-regions nil)		; for Lemacs
	 (mark-active t)		; for Emacs
	 (point (point-marker))
	 (mark  (copy-marker (mark-marker))))

    ;; make sure point comes before mark, not all functions are

    ;; finally, free the point-marker
    (set-marker point nil)
    (set-marker mark nil)
    )
  (run-hooks 'sc-post-hook)
  ;; post hook could have changed the variables
  (sc-set-mode-string))


;; ======================================================================
;; bug reporting and miscellaneous commands

  (interactive "p")
  (save-excursion
    (let ((start (point))
	  (prefix (or (progn (beginning-of-line)
			     (if (looking-at (sc-cite-regexp))
				 (sc-submatch 0)))
		      "")))
      (goto-char start)
      (open-line arg)
      (forward-line 1)
      (while (< 0 arg)

	    (looking-at "^[ \t]*$")
	    (consp arg))
	(insert (sc-mail-field "sc-citation"))
      (error "Line is already cited"))))

(defun sc-version (arg)
  "Echo the current version of Supercite in the minibuffer.
With \\[universal-argument] (universal-argument), or if run non-interactively,
inserts the version string in the current buffer instead."
  (interactive "P")
  (let ((verstr (format "Using Supercite.el %s" sc-version)))
    (if (or (consp arg)
	    (not (interactive-p)))
	(insert "`sc-version' says: " verstr)
      (message verstr))))

(defun sc-describe ()
  "
Supercite is a package which provides a flexible mechanism for citing
email and news replies.  Please see the associated texinfo file for
more information."
  (interactive)
  (describe-function 'sc-describe))

(defun sc-submit-bug-report ()
  "Submit a bug report on Supercite via mail."


;; useful stuff
(provide 'supercite)
(run-hooks 'sc-load-hook)

;;; supercite.el ends here

88155:d7ddb3e565de

;;; supercite.el --- minor mode for citing mail and news replies

;; Copyright (C) 1993, 1997, 2002, 2003, 2004,
;;   2005 Free Software Foundation, Inc.

;; Author: 1993 Barry A. Warsaw <[e-mail]>
;; Maintainer:    Glenn Morris <[e-mail]>
;; Created:       February 1993
;; Last Modified: 1993/09/22 18:58:46
;; Keywords: mail, news

;; supercite.el revision: 3.54

;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;; LCD Archive Entry
;; supercite|Barry A. Warsaw|[e-mail]
;; |Mail and news reply citation package
;; |1993/09/22 18:58:46|3.1|

;; start user configuration variables
;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv

(defgroup supercite nil
  "Supercite package."
  :prefix "sc-"
  :group 'mail
  :group 'news)

(defgroup supercite-frames nil
  "Supercite (regi) frames."
  :prefix "sc-"
  :group 'supercite)

(defgroup supercite-attr nil
  "Supercite attributions."
  :prefix "sc-"
  :group 'supercite)

(defgroup supercite-cite nil
  "Supercite citings."
  :prefix "sc-"
  :group 'supercite)

(defgroup supercite-hooks nil
  "Hooking into supercite."
  :prefix "sc-"
  :group 'supercite)

(defcustom sc-auto-fill-region-p t
  "*If non-nil, automatically fill each paragraph after it has been cited."

   (INFOKEY ((REGEXP . FRAME)
             (REGEXP . FRAME)
             (...)))

Where INFOKEY is a key for `sc-mail-field', REGEXP is a regular
expression to match against the INFOKEY's value.  FRAME is
a citation frame, or a symbol that represents the name of
a variable whose value is a citation frame."
  :type '(repeat (list symbol (repeat (cons regexp
					    (choice (repeat (repeat sexp))
						    symbol)))))
  :group 'supercite-frames)
(put 'sc-cite-frame-alist 'risky-local-variable t)

(defcustom sc-uncite-frame-alist '()
  "*Alist for frame selection during unciting.
See the variable `sc-cite-frame-alist' for details."
  :type '(repeat (list symbol (repeat (cons regexp
					    (choice (repeat (repeat sexp))
						    symbol)))))
  :group 'supercite-frames)
(put 'sc-uncite-frame-alist 'risky-local-variable t)

(defcustom sc-recite-frame-alist '()
  "*Alist for frame selection during reciting.
See the variable `sc-cite-frame-alist' for details."
  :type '(repeat (list symbol (repeat (cons regexp
					    (choice (repeat (repeat sexp))
						    symbol)))))
  :group 'supercite-frames)
(put 'sc-recite-frame-alist 'risky-local-variable t)

(defcustom sc-default-cite-frame
  '(;; initialize fill state and temporary variables when entering
    ;; frame. this makes things run much faster
    (begin (progn

    (end                        (sc-fill-if-different ""))
    )
  "*Default REGI frame for citing a region."
  :type '(repeat (repeat sexp))
  :group 'supercite-frames)
(put 'sc-default-cite-frame 'risky-local-variable t)

(defcustom sc-default-uncite-frame
  '(;; do nothing on a blank line
    ("^[ \t]*$"       nil)
    ;; if the line is cited, uncite it
    ((sc-cite-regexp) (sc-uncite-line))
    )
  "*Default REGI frame for unciting a region."
  :type '(repeat (repeat sexp))
  :group 'supercite-frames)
(put 'sc-default-uncite-frame 'risky-local-variable t)

(defcustom sc-default-recite-frame
  '(;; initialize fill state when entering frame
    (begin            (sc-fill-if-different))
    ;; do nothing on a blank line

    (end              (sc-fill-if-different ""))
    )
  "*Default REGI frame for reciting a region."
  :type '(repeat (repeat sexp))
  :group 'supercite-frames)
(put 'sc-default-recite-frame 'risky-local-variable t)

(defcustom sc-cite-region-limit t
  "*This variable controls automatic citation of yanked text.
Valid values are:

non-nil   -- cite the entire region, regardless of its size
nil       -- do not cite the region at all
<integer> -- a number indicating the threshold for citation.  When
	     the number of lines in the region is greater than this

  :type 'boolean
  :group 'supercite)

(defcustom sc-nuke-mail-headers 'all
  "*Controls mail header nuking.
Used in conjunction with `sc-nuke-mail-header-list'.  Valid values are:

`all'       -- nuke all mail headers
`none'      -- don't nuke any mail headers
`specified' -- nuke headers specified in `sc-nuke-mail-header-list'
`keep'      -- keep headers specified in `sc-nuke-mail-header-list'"

  :type '(repeat (list string
		       (repeat (cons regexp
				     (choice (sexp :tag "List to eval")
					     string)))))
  :group 'supercite-attr)
(put 'sc-attrib-selection-list 'risky-local-variable t)

(defcustom sc-attribs-preselect-hook nil
  "*Hook to run before selecting an attribution."
  :type 'hook
  :group 'supercite-attr

The variable `sc-preferred-header-style' controls which function in
this list is chosen for automatic reference header insertions.
Electric reference mode will cycle through this list of functions."
  :type '(repeat sexp)
  :group 'supercite)
(put 'sc-rewrite-header-list 'risky-local-variable t)

(defcustom sc-titlecue-regexp "\\s +-+\\s +"
  "*Regular expression describing the separator between names and titles.
Set to nil to treat entire field as a name."
  :type '(choice (const :tag "entire field as name" nil)

(defvar sc-mail-info nil
  "Alist of mail header information gleaned from reply buffer.")
(defvar sc-attributions nil
  "Alist of attributions for use when citing.")

(defvar sc-tmp-nested-regexp nil
  "Temporary regexp describing nested citations.")
(defvar sc-tmp-nonnested-regexp nil
  "Temporary regexp describing non-nested citations.")
(defvar sc-tmp-dumb-regexp nil
  "Temp regexp describing non-nested citation cited with a nesting citer.")

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

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

(defvar sc-mode-map-prefix "\C-c\C-p"
  "*Key binding to install Supercite keymap.
If this is nil, Supercite keymap is not installed.")

(defvar sc-T-keymap
  (let ((map (make-sparse-keymap)))
    (define-key map "a" 'sc-S-preferred-attribution-list)
    (define-key map "b" 'sc-T-mail-nuke-blank-lines)
    (define-key map "c" 'sc-T-confirm-always)
    (define-key map "d" 'sc-T-downcase)
    (define-key map "e" 'sc-T-electric-references)
    (define-key map "f" 'sc-T-auto-fill-region)
    (define-key map "h" 'sc-T-describe)
    (define-key map "l" 'sc-S-cite-region-limit)
    (define-key map "n" 'sc-S-mail-nuke-mail-headers)
    (define-key map "N" 'sc-S-mail-header-nuke-list)
    (define-key map "o" 'sc-T-electric-circular)
    (define-key map "p" 'sc-S-preferred-header-style)
    (define-key map "s" 'sc-T-nested-citation)
    (define-key map "u" 'sc-T-use-only-preferences)
    (define-key map "w" 'sc-T-fixup-whitespace)
    (define-key map "?" 'sc-T-describe)
    map)
  "Keymap for sub-keymap of setting and toggling functions.")

(defvar sc-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map "c"    'sc-cite-region)
    (define-key map "f"    'sc-mail-field-query)
    (define-key map "g"    'sc-mail-process-headers)
    (define-key map "h"    'sc-describe)
    (define-key map "i"    'sc-insert-citation)
    (define-key map "o"    'sc-open-line)
    (define-key map "r"    'sc-recite-region)
    (define-key map "\C-p" 'sc-raw-mode-toggle)
    (define-key map "u"    'sc-uncite-region)
    (define-key map "v"    'sc-version)
    (define-key map "w"    'sc-insert-reference)
    (define-key map "\C-t"  sc-T-keymap)
    (define-key map "\C-b" 'sc-submit-bug-report)
    (define-key map "?"    'sc-describe)
    map)
  "Keymap for Supercite quasi-mode.")

(defvar sc-electric-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map "p"    'sc-eref-prev)
    (define-key map "n"    'sc-eref-next)
    (define-key map "s"    'sc-eref-setn)
    (define-key map "j"    'sc-eref-jump)
    (define-key map "x"    'sc-eref-abort)
    (define-key map "q"    'sc-eref-abort)
    (define-key map "\r"   'sc-eref-exit)
    (define-key map "\n"   'sc-eref-exit)
    (define-key map "g"    'sc-eref-goto)
    (define-key map "?"    'describe-mode)
    (define-key map "\C-h" 'describe-mode)
    (define-key map [f1]   'describe-mode)
    (define-key map [help] 'describe-mode)
    map)
  "Keymap for `sc-electric-mode' electric references mode.")


(defvar sc-minibuffer-local-completion-map
  (let ((map (copy-keymap minibuffer-local-completion-map)))
    (define-key map "\C-t" 'sc-toggle-fn)
    (define-key map " "    'self-insert-command)
    map)
  "Keymap for minibuffer confirmation of attribution strings.")

(defvar sc-minibuffer-local-map
  (let ((map (copy-keymap minibuffer-local-map)))
    (define-key map "\C-t" 'sc-toggle-fn)
    map)
  "Keymap for minibuffer confirmation of attribution strings.")

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

(defun sc-ask (alist)
  "Ask a question in the minibuffer requiring a single character answer.
This function is kind of an extension of `y-or-n-p' where a single
letter is used to answer a question.  Question is formed from ALIST

		   (function
		    (lambda (elt) (char-to-string (cdr elt)))) alist "/")
		  ") "))
	 (p prompt)
	 (event
	  (if (fboundp 'allocate-event)
	      (allocate-event)
	    nil)))
    (while (stringp p)
      (if (let ((cursor-in-echo-area t)
		(inhibit-quit t))
	    (message "%s" p)
	    (setq event (read-event))
	    (prog1 quit-flag (setq quit-flag nil)))
	  (progn
	    (message "%s%s" p (single-key-description event))
	    (if (fboundp 'deallocate-event)
		(deallocate-event event))
	    (setq quit-flag nil)
	    (signal 'quit '())))
      (let ((char
	     (if (featurep 'xemacs)
		 (let* ((key (and (key-press-event-p event) (event-key event)))
			(char (and key (event-to-character event))))
		   char)
	       event))
	    elt)
	(if char (setq char (downcase char)))
	(cond
	 ((setq elt (rassq char alist))
	  (message "%s%s" p (car elt))
	  (setq p (cdr elt)))
	 ((if (fboundp 'button-release-event-p)
	      (button-release-event-p event)) ; ignore them
	  nil)
	 (t
	  (message "%s%s" p (single-key-description event))
	  (if (featurep 'xemacs)
	      (ding nil 'y-or-n-p)
	    (ding))
	  (discard-input)
	  (if (eq p prompt)
	      (setq p (concat "Try again.  " prompt)))))))
    (if (fboundp 'deallocate-event)
	(deallocate-event event))
    p))

(defun sc-scan-info-alist (alist)
  "Find a match in the info alist that matches a regexp in ALIST."
  (let ((sc-mumble "")

    ("^$"                         (list 'abort '(step . 0)))
    ("^[ \t]+"                    (sc-mail-append-field))
    (sc-mail-warn-if-non-rfc822-p (sc-mail-error-in-mail-field))
    (end                          (setq sc-mail-headers-end (point))))
  "Regi frame for glomming mail header information.")
(put 'sc-mail-glom-frame 'risky-local-variable t)

(defvar curline)			; dynamic bondage

;; regi functions
(defun sc-mail-fetch-field (&optional attribs-p)
  "Insert a key and value into `sc-mail-info' alist.
If optional ATTRIBS-P is non-nil, the key/value pair is placed in
`sc-attributions' too."
  (if (string-match "^\\(\\S *\\)\\s *:\\s +\\(.*\\)$" curline)
      (let* ((key (downcase (match-string-no-properties 1 curline)))
	     (val (match-string-no-properties 2 curline))
	     (keyval (cons key val)))
	(push keyval sc-mail-info)
	(if attribs-p
	    (push keyval sc-attributions))))
  nil)

(defun sc-mail-append-field ()
  "Append a continuation line onto the last fetched mail field's info."
  (let ((keyval (car sc-mail-info)))
    (if (and keyval (string-match "^\\s *\\(.*\\)$" curline))
	(setcdr keyval (concat (cdr keyval) " "
			       (match-string-no-properties 1 curline)))))
  nil)

(defun sc-mail-error-in-mail-field ()
  "Issue warning that mail headers don't conform to RFC 822."
  (let* ((len (min (length curline) 10))

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

(defun sc-mail-nuke-line ()
  "Nuke the current mail header line."
  (delete-region (line-beginning-position) (line-beginning-position 2))
  '((step . -1)))

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

	(skip-chars-backward " \t\n")
	(forward-line 1)
	(delete-blank-lines)
	(beginning-of-line)
	(if (looking-at "[ \t]*$")
	    (delete-region (line-beginning-position)
			   (line-beginning-position 2)))
	(insert-char ?\n sc-blank-lines-after-headers)))
  nil)

(defun sc-mail-build-nuke-frame ()
  "Build the regiframe for nuking mail headers."

     ((eq sc-nuke-mail-headers 'keep)
      (setq entry-func    '(setq sc-mail-last-header-nuked-p nil)
	    nonentry-func '(sc-mail-nuke-header-line)))
     ;; we never get far enough to interpret a frame if s-n-m-h == 'none
     ((eq sc-nuke-mail-headers 'none))
     (t (error "Invalid value for sc-nuke-mail-headers: %s"
	       sc-nuke-mail-headers))
     )					; end-cond
    (append
     (and entry-func
	  (regi-mapcar sc-nuke-mail-header-list entry-func nil t))

;; let the user change mail field information
(defun sc-mail-field (field)
  "Return the mail header field value associated with FIELD.
If there was no mail header with FIELD as its key, return the value of
`sc-mumble'.  FIELD is case insensitive."
  (or (cdr (assoc-string field sc-mail-info 'case-fold)) sc-mumble))

(defun sc-mail-field-query (arg)
  "View the value of a mail field.
With `\\[universal-argument]', prompts for action on mail field.
Action can be one of: View, Modify, Add, or Delete."

  (let* ((alist '(("view" . ?v) ("modify" . ?m) ("add" . ?a) ("delete" . ?d)))
	 (action (if (not arg) ?v (sc-ask alist)))
	 key)
    (if (not action)
	()
      (setq key (completing-read
		 (concat (car (rassq action alist))
			      " information key: ")
		 sc-mail-info nil
		 (if (eq action ?a) nil 'noexit)
		 nil 'sc-mail-field-history))

       ((eq action ?d)
	(setq sc-mail-info (delq (assoc key sc-mail-info) sc-mail-info)))
       ((eq action ?m)
	(let ((keyval (assoc key sc-mail-info)))
	  ;; first put initial value onto list if not already there
	  (if (not (member (cdr keyval)
			   sc-mail-field-modification-history))
	      (setq sc-mail-field-modification-history
		    (cons (cdr keyval) sc-mail-field-modification-history)))
	  (setcdr keyval (read-string
			  (concat key ": ") (cdr keyval)
			  'sc-mail-field-modification-history))))
       ((eq action ?a)
	(push (cons key (read-string (concat key ": "))) sc-mail-info))
       ))))

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

  "Extract the author's email terminus from email address FROM.
Match addresses of the style ``name%[stuff].'' when called with DELIM
of \"%\" and addresses of the style ``[stuff]name@[stuff]'' when
called with DELIM \"@\".  If DELIM is nil or not provided, matches
addresses of the style ``name''."
  (and (string-match (concat "[-[:alnum:]_.]+" delim) from 0)
       (substring from
		  (match-beginning 0)
		  (- (match-end 0) (if (null delim) 0 1)))))

(defun sc-attribs-!-addresses (from)
  "Extract the author's email terminus from email address FROM.
Match addresses of the style ``[stuff]![stuff]...!name[stuff].''"
  (let ((eos (length from))
	(mstart (string-match "![-[:alnum:]_.]+\\([^-![:alnum:]_.]\\|$\\)"
			      from 0))
	(mend (match-end 0)))
    (and mstart
	 (substring from (1+ mstart) (- mend (if (= mend eos) 0 1)))
	 )))

(defun sc-attribs-<>-addresses (from)
  "Extract the author's email terminus from email address FROM.
Match addresses of the style ``<name[stuff]>.''"
  (and (string-match "<\\(.*\\)>" from)
       (match-string 1 from)))

(defun sc-get-address (from author)
  "Get the full email address path from FROM.
AUTHOR is the author's name (which is removed from the address)."
  (let ((eos (length from)))
    (if (string-match (concat "\\`\"?" (regexp-quote author)
			      "\"?\\s +") from 0)
	(let ((address (substring from (match-end 0) eos)))
	  (if (and (= (aref address 0) ?<)
		   (= (aref address (1- (length address))) ?>))
	      (substring address 1 (1- (length address)))
	    address))
      (if (string-match "[-[:alnum:]!@%._]+" from 0)
	  (match-string 0 from)
	"")
      )))

(defun sc-attribs-emailname (from)
  "Get the email terminus name from FROM."

		    ))))

(defun sc-attribs-extract-namestring (from)
  "Extract the name string from FROM.
This should be the author's full name minus an optional title."
  ;; FIXME: we probably should use mail-extract-address-components.
  (let ((namestring
	 (or
	  ;; If there is a <...> in the name,
	  ;; treat everything before that as the full name.
	  ;; Even if it contains parens, use the whole thing.

	    (setq eos (1- eos)))
	  (substring namestring bos (1+ eos))))))

(defun sc-attribs-chop-namestring (namestring)
  "Convert NAMESTRING to a list of names.
example: (sc-attribs-chop-namestring \"John Xavier Doe\")
         => (\"John\" \"Xavier\" \"Doe\")"
  (if (string-match "\\([ \t]*\\)\\([^ \t._]+\\)\\([ \t]*\\)" namestring)
      (cons (match-string 2 namestring)
	    (sc-attribs-chop-namestring (substring namestring (match-end 3)))
	    )))

(defun sc-attribs-strip-initials (namelist)
  "Extract the author's initials from the NAMELIST."

(defun sc-guess-attribution (&optional string)
  "Guess attribution string on current line.
If attribution cannot be guessed, nil is returned.  Optional STRING if
supplied, is used instead of the line point is on in the current buffer."
  (let ((start 0)
	(string (or string (buffer-substring (line-beginning-position)
					     (line-end-position))))
	attribution)
    (and
     (= start (or (string-match sc-citation-leader-regexp string start) -1))
     (setq start (match-end 0))
     (= start (or (string-match sc-citation-root-regexp string start) 1))
     (setq attribution (match-string 0 string)
	   start (match-end 0))
     (= start (or (string-match sc-citation-delimiter-regexp string start) -1))
     (setq start (match-end 0))
     (= start (or (string-match sc-citation-separator-regexp string start) -1))
     attribution)))

	 middlenames (mapconcat
		      (function
		       (lambda (midname)
			 (let ((key-attribs (format "middlename-%d" n))
			       (key-mail    (format "sc-middlename-%d" n)))
			   (push (cons key-attribs midname) sc-attributions)
			   (push (cons key-mail midname) sc-mail-info)
			   (setq n (1+ n))
			   midname)))
		      midnames " ")

	 author (concat firstname " " middlenames (and midnames " ") lastname)

						   namestring))
			)
		       sc-mail-info)
	 ))
    ;; from string is empty
    (push (cons "sc-author" sc-default-author-name) sc-mail-info)))

(defvar sc-attrib-or-cite nil
  "Used to toggle between attribution input or citation input.")

(defun sc-toggle-fn ()

	      (setq attriblist (cdr attriblist)))
	     ((stringp attrib)
	      (setq attribution attrib
		    attriblist nil))
	     ((listp attrib)
	      (setq attribution (eval attrib))
              (if (stringp attribution)
                  (setq attriblist nil)
                (setq attribution nil
                      attriblist (cdr attriblist))))
	     (t (error "%s did not evaluate to a string or list!"
		       "sc-attrib-selection-list"))
	     )))
	 ((setq attribution (cdr (assoc preferred sc-attributions)))
	  (setq attriblist nil))

	  (while
	      (catch 'sc-reconfirm
		(progn
		  (setq choice
			(if sc-attrib-or-cite
			    (read-string
			     "Enter citation prefix: "
			     citation
			     'sc-citation-confirmation-history)
			  (completing-read
			   "Complete attribution name: "
			   query-alist nil nil
			   (cons initial 0)
			   'sc-attribution-confirmation-history)
			  ))

	   (akey "sc-attribution")
	   (ckeyval (assoc ckey sc-mail-info))
	   (akeyval (assoc akey sc-mail-info)))
      (if ckeyval
	  (setcdr ckeyval citation)
	(push (cons ckey citation) sc-mail-info))
      (if akeyval
	  (setcdr akeyval attribution)
	(push (cons akey attribution) sc-mail-info)))

    ;; set the sc-lastchoice attribution
    (let* ((lkey "sc-lastchoice")
	   (lastchoice (assoc lkey sc-attributions)))
      (if lastchoice
	  (setcdr lastchoice attribution)
	(push (cons lkey attribution) sc-attributions)))
    ))


;; ======================================================================
;; filladapt hooks for supercite 3.1. you shouldn't need anything

  (concat sc-citation-leader
	  attribution
	  sc-citation-delimiter
	  sc-citation-separator))

(defvar filladapt-prefix-table)

(defun sc-setup-filladapt ()
  "Setup `filladapt-prefix-table' to handle Supercited paragraphs."
  (let* ((fa-sc-elt 'filladapt-supercite-included-text)
	 (elt (rassq fa-sc-elt filladapt-prefix-table)))
    (if elt (setcar elt (sc-cite-regexp))

If `sc-auto-fill-region-p' is nil, do not fill region.  If PREFIX is
not supplied, initialize fill variables.  This is useful for a regi
`begin' frame-entry."
  (if (not prefix)
      (setq sc-fill-line-prefix ""
	    sc-fill-begin (line-beginning-position))
    (if (and sc-auto-fill-region-p
	     (not (string= prefix sc-fill-line-prefix)))
	(let ((fill-prefix sc-fill-line-prefix))
	  (if (not (string= fill-prefix ""))
	      (fill-region sc-fill-begin (line-beginning-position)))
	  (setq sc-fill-line-prefix prefix
		sc-fill-begin (line-beginning-position))))
    )
  nil)

(defun sc-cite-coerce-cited-line ()
  "Coerce a Supercited line to look like our style."

  "Guess the citation nesting on the current line.
If nesting cannot be guessed, nil is returned.  Optional STRING if
supplied, is used instead of the line point is on in the current
buffer."
  (let ((start 0)
	(string (or string (buffer-substring (line-beginning-position)
					     (line-end-position))))
	nesting)
    (and
     (= start (or (string-match sc-citation-leader-regexp string start) -1))
     (setq start (match-end 0))
     (= start (or (string-match sc-citation-delimiter-regexp string start) -1))
     (setq nesting (match-string 0 string)
	   start (match-end 0))
     (= start (or (string-match sc-citation-separator-regexp string start) -1))
     nesting)))

(defun sc-add-citation-level ()

    (insert (or prefix sc-default-attribution))
    (sc-fill-if-different prefix))
  nil)

;; interactive functions
(defun sc-cite-region (start end &optional confirm-p interactive)
  "Cite a region delineated by START and END.
If optional CONFIRM-P is non-nil, the attribution is confirmed before
its use in the citation string.  This function first runs
`sc-pre-cite-hook'.

When called interactively, the optional arg INTERACTIVE is non-nil,
and that means call `sc-select-attribution' too."
  (interactive "r\nP\np")
  (undo-boundary)
  (let ((frame (sc-scan-info-alist sc-cite-frame-alist))
	(sc-confirm-always-p (if confirm-p t sc-confirm-always-p)))
    (if (and frame (symbolp frame))
	(setq frame (symbol-value frame)))
    (or frame (setq frame sc-default-cite-frame))
    (run-hooks 'sc-pre-cite-hook)
    (if interactive
	(sc-select-attribution))
    (regi-interpret frame start end)))

(defun sc-uncite-region (start end)
  "Uncite a region delineated by START and END.
First runs `sc-pre-uncite-hook'."
  (interactive "r")
  (undo-boundary)
  (let ((frame (sc-scan-info-alist sc-uncite-frame-alist)))
    (if (and frame (symbolp frame))
	(setq frame (symbol-value frame)))
    (or frame (setq frame sc-default-uncite-frame))
    (run-hooks 'sc-pre-uncite-hook)
    (regi-interpret frame start end)))

(defun sc-recite-region (start end)
  "Recite a region delineated by START and END.
First runs `sc-pre-recite-hook'."
  (interactive "r")
  (let ((sc-confirm-always-p t))
    (sc-select-attribution))
  (undo-boundary)
  (let ((frame (sc-scan-info-alist sc-recite-frame-alist)))
    (if (and frame (symbolp frame))
	(setq frame (symbol-value frame)))
    (or frame (setq frame sc-default-recite-frame))
    (run-hooks 'sc-pre-recite-hook)
    (regi-interpret frame start end)))


;; ======================================================================

  (if (not (bobp))
      (if (and (eolp)
	       (progn (forward-line -1)
		      (or (= (point) (mail-header-end))
			  (and (eq major-mode 'mh-letter-mode)
			       (with-no-warnings
				 (mh-in-header-p))))))
	  (progn (forward-line)
		 (let ((kill-lines-magic t))
		   (kill-line))))))

(defun sc-header-on-said ()

	      (buffer-read-only t)
	      (mode-name "SC Electric Refs")
	      (major-mode 'sc-electric-mode))
	  (use-local-map sc-electric-mode-map)
	  (sc-eref-show sc-eref-style)
	  (run-mode-hooks 'sc-electric-mode-hook)
	  (recursive-edit)
	  )))

    (and sc-eref-style
	 (sc-eref-insert-selected))

  "Toggle, in one fell swoop, two important SC variables:
`sc-fixup-whitespace-p' and `sc-auto-fill-region-p'"
  (interactive)
  (setq sc-fixup-whitespace-p (not sc-fixup-whitespace-p)
	sc-auto-fill-region-p (not sc-auto-fill-region-p))
  (force-mode-line-update))

(defun sc-toggle-var (variable)
  "Boolean toggle VARIABLE's value.
VARIABLE must be a bound symbol.  nil values change to t, non-nil
values are changed to nil."
  (message "%s changed from %s to %s"
	   variable (symbol-value variable)
	   (set variable (not (symbol-value variable)))))

(defun sc-set-variable (var)
  "Set the Supercite VARIABLE.
This function mimics `set-variable', except that the variable to set
is determined non-interactively.  The value is queried for in the

You can see the current value of the variable when the minibuffer is
querying you by typing `C-h'.  Note that the format is changed
slightly from that used by `set-variable' -- the current value is
printed just after the variable's name instead of at the bottom of the
help window."
  (let* ((minibuffer-help-form '(funcall myhelp))
	 (myhelp
	  (lambda ()
	    (with-output-to-temp-buffer "*Help*"
	      (prin1 var)
	      (if (boundp var)
		  (let ((print-length 20))
		    (princ "\t(Current value: ")
		    (prin1 (symbol-value var))
		    (princ ")")))
	      (princ "\n\nDocumentation:\n")
	      (princ (substring (documentation-property
				 var
				 'variable-documentation)
				1))
	      (with-current-buffer standard-output
		(help-mode))
	      nil))))
    (set var (eval-minibuffer (format "Set %s to value: " var)))))

(defmacro sc-toggle-symbol (rootname)
  `(defun ,(intern (concat "sc-T-" rootname)) ()
     (interactive)
     (sc-toggle-var ',(intern (concat "sc-" rootname "-p")))))

(defmacro sc-setvar-symbol (rootname)
  `(defun ,(intern (concat "sc-S-" rootname)) ()
     (interactive)
     (sc-set-variable ',(intern (concat "sc-" rootname)))))

(sc-toggle-symbol "confirm-always")
(sc-toggle-symbol "downcase")
(sc-toggle-symbol "electric-references")
(sc-toggle-symbol "auto-fill-region")

\\{sc-T-keymap}"
  (interactive)
  (describe-function 'sc-T-describe))


;; ======================================================================
;; published interface to mail and news readers

(define-minor-mode sc-minor-mode
  "Supercite minor mode."
  :group 'supercite
  :lighter (" SC" (sc-auto-fill-region-p
		   (":f" (sc-fixup-whitespace-p "w"))
		   (sc-fixup-whitespace-p ":w")))
  :keymap `((,sc-mode-map-prefix . ,sc-mode-map)))

;;;###autoload
(defun sc-cite-original ()
  "Workhorse citing function which performs the initial citation.
This is callable from the various mail and news readers' reply
function according to the agreed upon standard.  See the associated
info node `(SC)Top' for more details.
`sc-cite-original' does not do any yanking of the
original message but it does require a few things:

     1) The reply buffer is the current buffer.

     2) The original message has been yanked and inserted into the

For Emacs 19's, the region need not be active (and typically isn't
when this function is called.  Also, the hook `sc-pre-hook' is run
before, and `sc-post-hook' is run after the guts of this function."
  (run-hooks 'sc-pre-hook)

  (sc-minor-mode 1)

  (undo-boundary)

  ;; grab point and mark since the region is probably not active when
  ;; this function gets automatically called. we want point to be a
  ;; mark so any deleting before point works properly
  (let* ((zmacs-regions nil)		; for XEemacs
	 (mark-active t)		; for Emacs
	 (point (point-marker))
	 (mark  (copy-marker (mark-marker))))

    ;; make sure point comes before mark, not all functions are

    ;; finally, free the point-marker
    (set-marker point nil)
    (set-marker mark nil)
    )
  (run-hooks 'sc-post-hook))


;; ======================================================================
;; bug reporting and miscellaneous commands

  (interactive "p")
  (save-excursion
    (let ((start (point))
	  (prefix (or (progn (beginning-of-line)
			     (if (looking-at (sc-cite-regexp))
				 (match-string 0)))
		      "")))
      (goto-char start)
      (open-line arg)
      (forward-line 1)
      (while (< 0 arg)

	    (looking-at "^[ \t]*$")
	    (consp arg))
	(insert (sc-mail-field "sc-citation"))
      (error "Line is already cited"))))

(defun sc-version (message)
  "Echo the current version of Supercite in the minibuffer.
If MESSAGE is non-nil (interactively, with no prefix argument),
inserts the version string in the current buffer instead."
  (interactive (not current-prefix-arg))
  (let ((verstr (format "Using Supercite.el %s" sc-version)))
    (if message
	(message verstr)
      (insert "`sc-version' says: " verstr))))

(defun sc-describe ()
  "
Supercite is a package which provides a flexible mechanism for citing
email and news replies.  Please see the associated texinfo file for
more information.  Info node `(SC)Top'."
  (interactive)
  (describe-function 'sc-describe))

(defun sc-submit-bug-report ()
  "Submit a bug report on Supercite via mail."


;; useful stuff
(provide 'supercite)
(run-hooks 'sc-load-hook)

;; arch-tag: a5d5bfa6-3bd5-4414-8c65-0afc83e45cd3
;;; supercite.el ends here