;;; supercite.el --- minor mode for citing mail and news replies
-;; Copyright (C) 1993, 1997 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1997, 2003 Free Software Foundation, Inc.
;; Author: 1993 Barry A. Warsaw, Century Computing, Inc. <bwarsaw@cen.com>
-;; Maintainer: supercite-help@python.org
+;; Maintainer: FSF
;; Created: February 1993
;; Last Modified: 1993/09/22 18:58:46
;; Keywords: mail, news
;; Boston, MA 02111-1307, 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)
;; Nemacs and Mule users note: please see the texinfo manual for
;; suggestions on setting these variables.
-(defcustom 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'."
:type 'regexp
:group 'supercite-cite)
-(defcustom sc-citation-nonnested-root-regexp "[-._a-zA-Z0-9]+"
+(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 whereas that variable
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
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."
- :type '(repeat (list symbol (repeat (cons regexp
- (choice (repeat (repeat sexp))
- symbol)))))
+ :type '(repeat (list string
+ (repeat (cons regexp
+ (choice (sexp :tag "List to eval")
+ string)))))
:group 'supercite-attr)
(defcustom sc-attribs-preselect-hook 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)
- (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)
- ;; 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)
+ (and (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)
+ ((and (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)
+ (and (fboundp 'deallocate-event)
(deallocate-event event))
p))
(end (setq sc-mail-headers-end (point))))
"Regi frame for glomming mail header information.")
+(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)))
+ (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)
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.
(= (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,
(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))
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 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
`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)))
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'."
(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))))
(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."
+ nil (" SC" (sc-auto-fill-region-p
+ (":f" (sc-fixup-whitespace-p "w"))
+ (sc-fixup-whitespace-p ":w")))
+ `((,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)
"Echo the current version of Supercite in the minibuffer.
"
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