;;; supercite.el --- minor mode for citing mail and news replies
-;; Author: 1993 Barry A. Warsaw, Century Computing, Inc. <bwarsaw@cen.com>
-;; Maintainer: supercite-help@anthem.nlm.nih.gov
+;; Copyright (C) 1993, 1997, 2001, 2002, 2003, 2004,
+;; 2005, 2006, 2007 Free Software Foundation, Inc.
+
+;; Author: 1993 Barry A. Warsaw <bwarsaw@python.org>
+;; Maintainer: Glenn Morris <rgm@gnu.org>
;; Created: February 1993
-;; Version: 3.1
;; Last Modified: 1993/09/22 18:58:46
;; Keywords: mail, news
;; supercite.el revision: 3.54
-;; Copyright (C) 1993 Barry A. Warsaw
-
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; 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|supercite-help@anthem.nlm.nih.gov
+;; supercite|Barry A. Warsaw|supercite-help@python.org
;; |Mail and news reply citation package
;; |1993/09/22 18:58:46|3.1|
-;; Code:
+;;; Commentary:
+
+;;; Code:
\f
(require 'regi)
+(require 'sendmail) ;; For mail-header-end.
;; start user configuration variables
;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
-(defvar sc-auto-fill-region-p t
- "*If non-nil, automatically fill each paragraph after it has been cited.")
-
-(defvar sc-blank-lines-after-headers 1
+(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."
+ :type 'boolean
+ :group 'supercite)
+
+(defcustom sc-blank-lines-after-headers 1
"*Number of blank lines to leave after mail headers have been nuked.
-Set to nil, to use whatever blank lines happen to occur naturally.")
+Set to nil, to use whatever blank lines happen to occur naturally."
+ :type '(choice (const :tag "leave" nil)
+ integer)
+ :group 'supercite)
+
+(defcustom sc-citation-leader " "
+ "*String comprising first part of a citation."
+ :type 'string
+ :group 'supercite-cite)
-(defvar sc-citation-leader " "
- "*String comprising first part of a citation.")
-(defvar sc-citation-delimiter ">"
+(defcustom sc-citation-delimiter ">"
"*String comprising third part of a citation.
-This string is used in both nested and non-nested citations.")
-(defvar sc-citation-separator " "
- "*String comprising fourth and last part of a citation.")
+This string is used in both nested and non-nested citations."
+ :type 'string
+ :group 'supercite-cite)
-(defvar sc-citation-leader-regexp "[ \t]*"
+(defcustom sc-citation-separator " "
+ "*String comprising fourth and last part of a citation."
+ :type 'string
+ :group 'supercite-cite)
+
+(defcustom sc-citation-leader-regexp "[ \t]*"
"*Regexp describing citation leader for a cited line.
-This should NOT have a leading `^' character.")
+This should NOT have a leading `^' character."
+ :type 'regexp
+ :group 'supercite-cite)
;; Nemacs and Mule users note: please see the texinfo manual for
;; suggestions on setting these variables.
-(defvar sc-citation-root-regexp "[-._a-zA-Z0-9]*"
+(defcustom sc-citation-root-regexp "[-._[:alnum:]]*"
"*Regexp describing variable root part of a citation for a cited line.
This should NOT have a leading `^' character. See also
-`sc-citation-nonnested-root-regexp'.")
-(defvar sc-citation-nonnested-root-regexp "[-._a-zA-Z0-9]+"
+`sc-citation-nonnested-root-regexp'."
+ :type 'regexp
+ :group 'supercite-cite)
+
+(defcustom sc-citation-nonnested-root-regexp "[-._[:alnum:]]+"
"*Regexp describing the variable root part of a nested citation.
This should NOT have a leading `^' character. This variable is
-related to `sc-citation-root-regexp' but where as that varariable
+related to `sc-citation-root-regexp' but whereas that variable
describes both nested and non-nested citation roots, this variable
-describes only nested citation roots.")
-(defvar sc-citation-delimiter-regexp "[>]+"
+describes only nested citation roots."
+ :type 'regexp
+ :group 'supercite-cite)
+
+(defcustom sc-citation-delimiter-regexp "[>]+"
"*Regexp describing citation delimiter for a cited line.
-This should NOT have a leading `^' character.")
-(defvar sc-citation-separator-regexp "[ \t]*"
+This should NOT have a leading `^' character."
+ :type 'regexp
+ :group 'supercite-cite)
+
+(defcustom sc-citation-separator-regexp "[ \t]*"
"*Regexp describing citation separator for a cited line.
-This should NOT have a leading `^' character.")
+This should NOT have a leading `^' character."
+ :type 'regexp
+ :group 'supercite-cite)
-(defvar sc-cite-blank-lines-p nil
- "*If non-nil, put a citation on blank lines.")
+(defcustom sc-cite-blank-lines-p nil
+ "*If non-nil, put a citation on blank lines."
+ :type 'boolean
+ :group 'supercite-cite)
-(defvar sc-cite-frame-alist '()
+(defcustom sc-cite-frame-alist '()
"*Alist for frame selection during citing.
Each element of this list has the following form:
-
(INFOKEY ((REGEXP . FRAME)
(REGEXP . FRAME)
(...)))
Where INFOKEY is a key for `sc-mail-field', REGEXP is a regular
-expression to match against the INFOKEY's value. FRAME is a citation
-frame, or a variable containing a citation frame.")
-(defvar sc-uncite-frame-alist '()
+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.")
-(defvar sc-recite-frame-alist '()
+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.")
-
-(defvar sc-default-cite-frame
+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
;; be sure when we're done that we fill the last cited paragraph.
(end (sc-fill-if-different ""))
)
- "*Default REGI frame for citing a region.")
+ "*Default REGI frame for citing a region."
+ :type '(repeat (repeat sexp))
+ :group 'supercite-frames)
+(put 'sc-default-cite-frame 'risky-local-variable t)
-(defvar sc-default-uncite-frame
+(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.")
+ "*Default REGI frame for unciting a region."
+ :type '(repeat (repeat sexp))
+ :group 'supercite-frames)
+(put 'sc-default-uncite-frame 'risky-local-variable t)
-(defvar sc-default-recite-frame
+(defcustom sc-default-recite-frame
'(;; initialize fill state when entering frame
(begin (sc-fill-if-different))
;; do nothing on a blank line
;; be sure when we're done that we fill the last cited paragraph.
(end (sc-fill-if-different ""))
)
- "*Default REGI frame for reciting a region.")
+ "*Default REGI frame for reciting a region."
+ :type '(repeat (repeat sexp))
+ :group 'supercite-frames)
+(put 'sc-default-recite-frame 'risky-local-variable t)
-(defvar sc-cite-region-limit t
+(defcustom sc-cite-region-limit t
"*This variable controls automatic citation of yanked text.
-Legal values are:
+Valid values are:
non-nil -- cite the entire region, regardless of its size
nil -- do not cite the region at all
the number of lines in the region is greater than this
value, a warning message will be printed and the region
will not be cited. Lines in region are counted with
- `count-lines'.
+ `count-lines'.
The gathering of attribution information is not affected by the value
of this variable. The number of lines in the region is calculated
*after* all mail headers are removed. This variable is only consulted
-during the initial citing via `sc-cite-original'.")
-
-(defvar sc-confirm-always-p t
- "*If non-nil, always confirm attribution string before citing text body.")
-
-(defvar sc-default-attribution "Anon"
- "*String used when author's attribution cannot be determined.")
-(defvar sc-default-author-name "Anonymous"
- "*String used when author's name cannot be determined.")
-
-(defvar sc-downcase-p nil
- "*Non-nil means downcase the attribution and citation strings.")
-
-(defvar sc-electric-circular-p t
- "*If non-nil, treat electric references as circular.")
-(defvar sc-electric-mode-hook nil
- "*Hook for `sc-electric-mode' electric references mode.")
-(defvar sc-electric-references-p nil
- "*Use electric references if non-nil.")
-
-(defvar sc-fixup-whitespace-p nil
- "*If non-nil, delete all leading white space before citing.")
-
-(defvar sc-load-hook nil
- "*Hook which gets run once after Supercite loads.")
-(defvar sc-pre-hook nil
- "*Hook which gets run before each invocation of `sc-cite-original'.")
-(defvar sc-post-hook nil
- "*Hook which gets run after each invocation of `sc-cite-original'.")
-
-(defvar sc-mail-warn-if-non-rfc822-p t
- "*Warn if mail headers don't conform to RFC822.")
-(defvar sc-mumble ""
- "*Value returned by `sc-mail-field' if field isn't in mail headers.")
-
-(defvar sc-name-filter-alist
+during the initial citing via `sc-cite-original'."
+ :type '(choice (const :tag "do not cite" nil)
+ (integer :tag "citation threshold")
+ (other :tag "always cite" t))
+ :group 'supercite-cite)
+
+(defcustom sc-confirm-always-p t
+ "*If non-nil, always confirm attribution string before citing text body."
+ :type 'boolean
+ :group 'supercite-attr)
+
+(defcustom sc-default-attribution "Anon"
+ "*String used when author's attribution cannot be determined."
+ :type 'string
+ :group 'supercite-attr)
+(defcustom sc-default-author-name "Anonymous"
+ "*String used when author's name cannot be determined."
+ :type 'string
+ :group 'supercite-attr)
+(defcustom sc-downcase-p nil
+ "*Non-nil means downcase the attribution and citation strings."
+ :type 'boolean
+ :group 'supercite-attr
+ :group 'supercite-cite)
+(defcustom sc-electric-circular-p t
+ "*If non-nil, treat electric references as circular."
+ :type 'boolean
+ :group 'supercite-attr)
+
+(defcustom sc-electric-mode-hook nil
+ "*Hook for `sc-electric-mode' electric references mode."
+ :type 'hook
+ :group 'supercite-hooks)
+(defcustom sc-electric-references-p nil
+ "*Use electric references if non-nil."
+ :type 'boolean
+ :group 'supercite)
+
+(defcustom sc-fixup-whitespace-p nil
+ "*If non-nil, delete all leading white space before citing."
+ :type 'boolean
+ :group 'supercite)
+
+(defcustom sc-load-hook nil
+ "*Hook which gets run once after Supercite loads."
+ :type 'hook
+ :group 'supercite-hooks)
+(defcustom sc-pre-hook nil
+ "*Hook which gets run before each invocation of `sc-cite-original'."
+ :type 'hook
+ :group 'supercite-hooks)
+(defcustom sc-post-hook nil
+ "*Hook which gets run after each invocation of `sc-cite-original'."
+ :type 'hook
+ :group 'supercite-hooks)
+
+(defcustom sc-mail-warn-if-non-rfc822-p t
+ "*Warn if mail headers don't conform to RFC822."
+ :type 'boolean
+ :group 'supercite-attr)
+(defcustom sc-mumble ""
+ "*Value returned by `sc-mail-field' if field isn't in mail headers."
+ :type 'string
+ :group 'supercite-attr)
+
+(defcustom sc-name-filter-alist
'(("^\\(Mr\\|Mrs\\|Ms\\|Dr\\)[.]?$" . 0)
("^\\(Jr\\|Sr\\)[.]?$" . last)
("^ASTS$" . 0)
Match is performed using `string-match'. POSITION is the position in
the name list which can match the regular expression, starting at zero
for the first element. Use `last' to match the last element in the
-list and `any' to match all elements.")
+list and `any' to match all elements."
+ :type '(repeat (cons regexp (choice (const last) (const any)
+ (integer :tag "position"))))
+ :group 'supercite-attr)
-(defvar sc-nested-citation-p nil
+(defcustom sc-nested-citation-p nil
"*Controls whether to use nested or non-nested citation style.
-Non-nil uses nested citations, nil uses non-nested citations.")
+Non-nil uses nested citations, nil uses non-nested citations."
+ :type 'boolean
+ :group 'supercite)
-(defvar sc-nuke-mail-headers 'all
+(defcustom sc-nuke-mail-headers 'all
"*Controls mail header nuking.
-Used in conjunction with `sc-nuke-mail-header-list'. Legal values are:
+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'")
+`keep' -- keep headers specified in `sc-nuke-mail-header-list'"
+ :type '(choice (const all) (const none)
+ (const specified) (const keep))
+ :group 'supercite)
-(defvar sc-nuke-mail-header-list nil
+(defcustom sc-nuke-mail-header-list nil
"*List of mail header regexps to remove or keep in body of reply.
This list contains regular expressions describing the mail headers to
-keep or nuke, depending on the value of `sc-nuke-mail-headers'.")
+keep or nuke, depending on the value of `sc-nuke-mail-headers'."
+ :type '(repeat regexp)
+ :group 'supercite)
-(defvar sc-preferred-attribution-list
+(defcustom sc-preferred-attribution-list
'("sc-lastchoice" "x-attribution" "firstname" "initials" "lastname")
"*Specifies what to use as the attribution string.
Supercite creates a list of possible attributions when it scans the
Middle name indexes can be any positive integer greater than 0,
although it is unlikely that many authors will supply more than one
middle name, if that many. The string of all middle names is
-associated with the key \"middlenames\".")
+associated with the key \"middlenames\"."
+ :type '(repeat string)
+ :group 'supercite-attr)
-(defvar sc-attrib-selection-list nil
+(defcustom sc-attrib-selection-list nil
"*An alist for selecting preferred attribution based on mail headers.
Each element of this list has the following form:
(...)))
Where INFOKEY is a key for `sc-mail-field', REGEXP is a regular
-expression to match against the INFOKEY's value. ATTRIBUTION can be a
-string or a list. If its a string, then it is the attribution that is
+expression to match against the INFOKEY's value. ATTRIBUTION can be a
+string or a list. If it's a string, then it is the attribution that is
selected by `sc-select-attribution'. If it is a list, it is `eval'd
and the return value must be a string, which is used as the selected
attribution. Note that the variable `sc-preferred-attribution-list'
must contain an element of the string \"sc-consult\" for this variable
-to be consulted during attribution selection.")
-
-(defvar sc-attribs-preselect-hook nil
- "*Hook to run before selecting an attribution.")
-(defvar sc-attribs-postselect-hook nil
- "*Hook to run after selecting an attribution, but before confirmation.")
-
-(defvar sc-pre-cite-hook nil
- "*Hook to run before citing a region of text.")
-(defvar sc-pre-uncite-hook nil
- "*Hook to run before unciting a region of text.")
-(defvar sc-pre-recite-hook nil
- "*Hook to run before reciting a region of text.")
-
-(defvar sc-preferred-header-style 4
+to be consulted during attribution selection."
+ :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
+ :group 'supercite-hooks)
+(defcustom sc-attribs-postselect-hook nil
+ "*Hook to run after selecting an attribution, but before confirmation."
+ :type 'hook
+ :group 'supercite-attr
+ :group 'supercite-hooks)
+
+(defcustom sc-pre-cite-hook nil
+ "*Hook to run before citing a region of text."
+ :type 'hook
+ :group 'supercite-cite
+ :group 'supercite-hooks)
+(defcustom sc-pre-uncite-hook nil
+ "*Hook to run before unciting a region of text."
+ :type 'hook
+ :group 'supercite-cite
+ :group 'supercite-hooks)
+(defcustom sc-pre-recite-hook nil
+ "*Hook to run before reciting a region of text."
+ :type 'hook
+ :group 'supercite-cite
+ :group 'supercite-hooks)
+
+(defcustom sc-preferred-header-style 4
"*Index into `sc-rewrite-header-list' specifying preferred header style.
-Index zero accesses the first function in the list.")
+Index zero accesses the first function in the list."
+ :type 'integer
+ :group 'supercite)
-(defvar sc-reference-tag-string ">>>>> "
- "*String used at the beginning of built-in reference headers.")
+(defcustom sc-reference-tag-string ">>>>> "
+ "*String used at the beginning of built-in reference headers."
+ :type 'string
+ :group 'supercite)
-(defvar sc-rewrite-header-list
+(defcustom sc-rewrite-header-list
'((sc-no-header)
(sc-header-on-said)
(sc-header-inarticle-writes)
"*List of reference header rewrite functions.
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.")
+Electric reference mode will cycle through this list of functions."
+ :type '(repeat sexp)
+ :group 'supercite)
+(put 'sc-rewrite-header-list 'risky-local-variable t)
-(defvar sc-titlecue-regexp "\\s +-+\\s +"
+(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.")
+Set to nil to treat entire field as a name."
+ :type '(choice (const :tag "entire field as name" nil)
+ regexp)
+ :group 'supercite-attr)
-(defvar sc-use-only-preference-p nil
+(defcustom sc-use-only-preference-p nil
"*Controls what happens when the preferred attribution cannot be found.
If non-nil, then `sc-default-attribution' will be used. If nil, then
some secondary scheme will be employed to find a suitable attribution
-string.")
+string."
+ :type 'boolean
+ :group 'supercite-attr)
;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
;; end user configuration variables
\f
(defconst sc-version "3.1"
"Supercite version number.")
-(defconst sc-help-address "supercite-help@anthem.nlm.nih.gov"
+(defconst sc-help-address "bug-supercite@gnu.org"
"Address accepting submissions of bug reports.")
(defvar sc-mail-info nil
(defvar sc-attributions nil
"Alist of attributions for use when citing.")
-(defconst sc-emacs-features
- (let ((version 'v18)
- (flavor 'GNU))
- (if (string= (substring emacs-version 0 2) "19")
- (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:
-
-All GNU18's: (v18 GNU)
-FSF19.x : (v19 GNU)
-Lucid19.x : (v19 Lucid)")
-
-
(defvar sc-tmp-nested-regexp nil
- "Temporary regepx describing nested citations.")
+ "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.")
-(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)
\f
;; ======================================================================
"*Key binding to install Supercite keymap.
If this is nil, Supercite keymap is not installed.")
-(defvar sc-T-keymap ()
+(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.")
-(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 ()
+
+(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.")
-(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 ()
+
+(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.")
-(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)
- )
-
-(defvar sc-minibuffer-local-completion-map nil
+
+
+(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.")
-(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
+
+(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.")
-(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))
\f
;; ======================================================================
;; 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)
- ;; maybe future versions will take a `history' argument:
- (read-string prompt initial-contents)
- (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
") "))
(p prompt)
(event
- (if (memq 'Lucid sc-emacs-features)
+ (if (fboundp 'allocate-event)
(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 FSF19
- (setq event (read-event))))
+ (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))
+ (if (fboundp 'deallocate-event)
+ (deallocate-event event))
(setq quit-flag nil)
(signal 'quit '())))
(let ((char
- (if (memq 'Lucid sc-emacs-features)
+ (if (featurep 'xemacs)
(let* ((key (and (key-press-event-p event) (event-key event)))
(char (and key (event-to-character event))))
char)
((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
+ ((if (fboundp 'button-release-event-p)
+ (button-release-event-p event)) ; ignore them
nil)
(t
(message "%s%s" p (single-key-description event))
- (if (memq 'Lucid sc-emacs-features)
+ (if (featurep 'xemacs)
(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))
+ (if (fboundp 'deallocate-event)
+ (deallocate-event event))
p))
(defun sc-scan-info-alist (alist)
(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)
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)))
+ (let* ((key (downcase (match-string-no-properties 1 curline)))
+ (val (match-string-no-properties 2 curline))
(keyval (cons key val)))
- (setq sc-mail-info (cons keyval sc-mail-info))
+ (push keyval sc-mail-info)
(if attribs-p
- (setq sc-attributions (cons keyval sc-attributions)))
- ))
+ (push keyval sc-attributions))))
nil)
(defun sc-mail-append-field ()
(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))))))
+ (match-string-no-properties 1 curline)))))
nil)
(defun sc-mail-error-in-mail-field ()
(defun sc-mail-nuke-line ()
"Nuke the current mail header line."
- (delete-region (regi-pos 'bol) (regi-pos 'bonl))
+ (delete-region (line-beginning-position) (line-beginning-position 2))
'((step . -1)))
(defun sc-mail-nuke-header-line ()
(delete-blank-lines)
(beginning-of-line)
(if (looking-at "[ \t]*$")
- (delete-region (regi-pos 'bol) (regi-pos 'bonl)))
+ (delete-region (line-beginning-position)
+ (line-beginning-position 2)))
(insert-char ?\n sc-blank-lines-after-headers)))
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"
+ (t (error "Invalid value for sc-nuke-mail-headers: %s"
sc-nuke-mail-headers))
) ; end-cond
(append
"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))
+ (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.
key)
(if (not action)
()
- (setq key (sc-completing-read
+ (setq key (completing-read
(concat (car (rassq action alist))
" information key: ")
sc-mail-info nil
((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))
+ (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 (sc-read-string
+ (setcdr keyval (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)))
+ (push (cons key (read-string (concat key ": "))) sc-mail-info))
))))
\f
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)
+ (and (string-match (concat "[-[:alnum:]_.]+" delim) from 0)
(substring from
(match-beginning 0)
(- (match-end 0) (if (null delim) 0 1)))))
"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_.]\\|$\\)"
+ (mstart (string-match "![-[:alnum:]_.]+\\([^-![:alnum:]_.]\\|$\\)"
from 0))
(mend (match-end 0)))
(and mstart
"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)))
+ (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 "\\(^\\|^\"\\)" author
- "\\(\\s +\\|\"\\s +\\)") from 0)
+ (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 "[-a-zA-Z0-9!@%._]+" from 0)
- (sc-submatch 0 from)
+ (if (string-match "[-[:alnum:]!@%._]+" from 0)
+ (match-string 0 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.
+ ;; On the other hand, we do look for quotes in the usual way.
+ (and (string-match " *<.*>" from 0)
+ (let ((before-angles
+ (sc-name-substring from 0 (match-beginning 0) 0)))
+ (if (string-match "\".*\"" before-angles 0)
+ (sc-name-substring
+ before-angles (match-beginning 0) (match-end 0) 1)
+ before-angles)))
(sc-name-substring
from (string-match "(.*)" from 0) (match-end 0) 1)
(sc-name-substring
from (string-match "\".*\"" from 0) (match-end 0) 1)
(sc-name-substring
- from (string-match "\\([-.a-zA-Z0-9_]+\\s +\\)+<" from 0)
+ from (string-match "\\([-.[:alnum:]_]+\\s +\\)+<" from 0)
(match-end 1) 0)
(sc-attribs-emailname from))))
;; strip off any leading or trailing whitespace
(defun sc-attribs-chop-namestring (namestring)
"Convert NAMESTRING to a list of names.
-example: (sc-namestring-to-list \"John Xavier Doe\")
+example: (sc-attribs-chop-namestring \"John Xavier Doe\")
=> (\"John\" \"Xavier\" \"Doe\")"
(if (string-match "\\([ \t]*\\)\\([^ \t._]+\\)\\([ \t]*\\)" namestring)
- (cons (sc-submatch 2 namestring)
+ (cons (match-string 2 namestring)
(sc-attribs-chop-namestring (substring namestring (match-end 3)))
)))
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))))
+ (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 (sc-submatch 0 string)
+ (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))
(let ((elements (length namelist))
(position -1)
keepers filtered-list)
- (mapcar
+ (mapc
(function
(lambda (name)
(setq position (1+ position))
(let ((keep-p t))
- (mapcar
+ (mapc
(function
(lambda (filter)
(let ((regexp (car filter))
(setq keepers (cons position keepers)))
)))
namelist)
- (mapcar
+ (mapc
(function
(lambda (position)
(setq filtered-list (cons (nth position namelist) filtered-list))
This populates the `sc-attributions' with the list of possible attributions."
(if (and (stringp from)
(< 0 (length from)))
- (let* ((sc-mumble "")
+ (let* ((sc-mumble "")
(namestring (sc-attribs-extract-namestring from))
(namelist (sc-attribs-filter-namelist
(sc-attribs-chop-namestring namestring)))
(emailname (sc-attribs-emailname from))
(n 1)
author middlenames)
-
+
;; put basic information
(setq
;; put middle names and build sc-author entry
(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))
+ (push (cons key-attribs midname) sc-attributions)
+ (push (cons key-mail midname) sc-mail-info)
+ (setq n (1+ n))
midname)))
midnames " ")
sc-mail-info)
))
;; from string is empty
- (setq sc-mail-info (cons (cons "sc-author" sc-default-author-name)
- sc-mail-info))))
+ (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.")
(setq attribution attrib
attriblist nil))
((listp attrib)
- (setq attribution (eval attrib)
- attriblist nil))
+ (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 sc-attrib-or-cite nil) ; nil==attribution, t==citation
(while
(catch 'sc-reconfirm
- (string= "" (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)
- )))))
+ (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)
+ ))
+ nil)))
(if sc-attrib-or-cite
;; since the citation was chosen, we have to guess at
;; the attribution
(setq citation choice
attribution (or (sc-guess-attribution citation)
citation))
-
+
(setq citation (sc-make-citation choice)
attribution choice))
))
(akeyval (assoc akey sc-mail-info)))
(if ckeyval
(setcdr ckeyval citation)
- (setq sc-mail-info
- (append (list (cons ckey citation)) sc-mail-info)))
+ (push (cons ckey citation) sc-mail-info))
(if akeyval
(setcdr akeyval attribution)
- (setq sc-mail-info
- (append (list (cons akey attribution)) sc-mail-info))))
+ (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)
- (setq sc-attributions
- (cons (cons lkey attribution) sc-attributions))))
+ (push (cons lkey attribution) sc-attributions)))
))
\f
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)
`begin' frame-entry."
(if (not prefix)
(setq sc-fill-line-prefix ""
- sc-fill-begin (regi-pos 'bol))
+ 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 (regi-pos 'bol)))
+ (fill-region sc-fill-begin (line-beginning-position)))
(setq sc-fill-line-prefix prefix
- sc-fill-begin (regi-pos 'bol))))
+ sc-fill-begin (line-beginning-position))))
)
nil)
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))))
+ (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 (sc-submatch 0 string)
+ (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 ()
- "Add a citation level for nested citation style w/ coersion."
+ "Add a citation level for nested citation style w/ coercion."
(let* ((nesting (sc-guess-nesting))
(citation (make-string (1+ (length nesting))
(string-to-char sc-citation-delimiter)))
nil)
;; interactive functions
-(defun sc-cite-region (start end &optional confirm-p)
+(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'."
- (interactive "r\nP")
+`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 (or (sc-scan-info-alist sc-cite-frame-alist)
- sc-default-cite-frame))
+ (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-p)
+ (if interactive
(sc-select-attribution))
(regi-interpret frame start 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)))
+ (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'."
(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)))
+ (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)))
())
(defun sc-no-blank-line-or-header()
- "Similar to `sc-no-header' except it removes the preceeding blank line."
+ "Similar to `sc-no-header' except it removes the preceding blank line."
(if (not (bobp))
(if (and (eolp)
(progn (forward-line -1)
- (or (looking-at mail-header-separator)
+ (or (= (point) (mail-header-end))
(and (eq major-mode 'mh-letter-mode)
- (mh-in-header-p)))))
+ (with-no-warnings
+ (mh-in-header-p))))))
(progn (forward-line)
(let ((kill-lines-magic t))
(kill-line))))))
(progn
(eval ref)
(let ((lines (count-lines (point-min) (point-max))))
- (or nomsg (message "Ref header %d [%d line%s]: %s"
+ (or nomsg (message "Ref header %d [%d line%s]: %s"
sc-eref-style lines
(if (= lines 1) "" "s")
ref))))
(major-mode 'sc-electric-mode))
(use-local-map sc-electric-mode-map)
(sc-eref-show sc-eref-style)
- (run-hooks 'sc-electric-mode-hook)
+ (run-mode-hooks 'sc-electric-mode-hook)
(recursive-edit)
)))
(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
+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 variable (not (eval-expression variable))))
- (sc-set-mode-string))
+ (set variable (not (symbol-value variable)))))
(defun sc-set-variable (var)
"Set the Supercite VARIABLE.
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))
+ (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))
+ (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)
- (list 'defun (intern (concat "sc-T-" rootname)) '()
- (list 'interactive)
- (list 'sc-toggle-var
- (list 'quote (intern (concat "sc-" rootname "-p"))))))
+ `(defun ,(intern (concat "sc-T-" rootname)) ()
+ (interactive)
+ (sc-toggle-var ',(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))))))
+ `(defun ,(intern (concat "sc-S-" rootname)) ()
+ (interactive)
+ (sc-set-variable ',(intern (concat "sc-" rootname)))))
(sc-toggle-symbol "confirm-always")
(sc-toggle-symbol "downcase")
(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" "")
- )))
-
\f
;; ======================================================================
;; 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 `\\[sc-describe]'
-for more details. `sc-cite-original' does not do any yanking of the
+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.
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)
+ (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 Lemacs
- (mark-active t) ; for FSFmacs
+ (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
;; interactive "r"
(if (< mark point)
(set-marker point nil)
(set-marker mark nil)
)
- (run-hooks 'sc-post-hook)
- ;; post hook could have changed the variables
- (sc-set-mode-string))
+ (run-hooks 'sc-post-hook))
\f
;; ======================================================================
(let ((start (point))
(prefix (or (progn (beginning-of-line)
(if (looking-at (sc-cite-regexp))
- (sc-submatch 0)))
+ (match-string 0)))
"")))
(goto-char start)
(open-line arg)
(looking-at "^[ \t]*$")
(consp arg))
(insert (sc-mail-field "sc-citation"))
- (error "Line is already cited."))))
+ (error "Line is already cited"))))
-(defun sc-version (arg)
+(defun sc-version (message)
"Echo the current version of Supercite in the minibuffer.
-With \\[universal-argument] (universal-argument), or if run non-interactively,
+If MESSAGE is non-nil (interactively, with no prefix argument),
inserts the version string in the current buffer instead."
- (interactive "P")
+ (interactive (not current-prefix-arg))
(let ((verstr (format "Using Supercite.el %s" sc-version)))
- (if (or (consp arg)
- (not (interactive-p)))
- (insert "`sc-version' says: " verstr)
- (message verstr))))
+ (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."
+more information. Info node `(SC)Top'."
(interactive)
(describe-function 'sc-describe))
(provide 'supercite)
(run-hooks 'sc-load-hook)
+;; arch-tag: a5d5bfa6-3bd5-4414-8c65-0afc83e45cd3
;;; supercite.el ends here