;;; supercite.el --- minor mode for citing mail and news replies
-;; Copyright (C) 1993, 1997 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1997, 2001, 2002, 2003, 2004,
+;; 2005, 2006 Free Software Foundation, Inc.
-;; Author: 1993 Barry A. Warsaw, Century Computing, Inc. <bwarsaw@cen.com>
-;; Maintainer: Mark Senn <mds@ecn.purdue.edu>
+;; Author: 1993 Barry A. Warsaw <bwarsaw@python.org>
+;; Maintainer: Glenn Morris <rgm@gnu.org>
;; Created: February 1993
;; Last Modified: 1993/09/22 18:58:46
;; Keywords: mail, news
;; 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.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;; LCD Archive Entry
;; supercite|Barry A. Warsaw|supercite-help@python.org
;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
(defgroup supercite nil
- "Supercite package"
+ "Supercite package."
:prefix "sc-"
:group 'mail
:group 'news)
(defgroup supercite-frames nil
- "Supercite (regi) frames"
+ "Supercite (regi) frames."
:prefix "sc-"
:group 'supercite)
(defgroup supercite-attr nil
- "Supercite attributions"
+ "Supercite attributions."
:prefix "sc-"
:group 'supercite)
(defgroup supercite-cite nil
- "Supercite citings"
+ "Supercite citings."
:prefix "sc-"
:group 'supercite)
(defgroup supercite-hooks nil
- "Hooking into supercite"
+ "Hooking into supercite."
:prefix "sc-"
:group 'supercite)
(...)))
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."
+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.
(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.
(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
"*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
"*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
"*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.
-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
(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
(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."
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.
(defvar sc-attributions nil
"Alist of attributions for use when citing.")
-(defconst sc-emacs-features
- (let ((version 'v18)
- (flavor 'GNU))
- (if (or
- (string= (substring emacs-version 0 2) "19")
- (string= (substring emacs-version 0 2) "20"))
- (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 20 : (v19 GNU)
-Lucid 19 or 20 : (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)
- (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
+
+
+(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)
- (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
") "))
(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 Emacs 19
- (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)
-(eval-when-compile (defvar curline)) ; dynamic bondage
+(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 "[-[:alnum:]!@%._]+" from 0)
- (sc-submatch 0 from)
+ (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,
(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))
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)))
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)))
(progn (forward-line -1)
(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
+ (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)
(insert (sc-mail-field "sc-citation"))
(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