Mercurial > emacs
diff lisp/mail/supercite.el @ 88155:d7ddb3e565de
sync with trunk
author | Henrik Enberg <henrik.enberg@telia.com> |
---|---|
date | Mon, 16 Jan 2006 00:03:54 +0000 |
parents | 0d8b17d428b5 |
children |
line wrap: on
line diff
--- a/lisp/mail/supercite.el Sun Jan 15 23:02:10 2006 +0000 +++ b/lisp/mail/supercite.el Mon Jan 16 00:03:54 2006 +0000 @@ -1,9 +1,10 @@ ;;; supercite.el --- minor mode for citing mail and news replies -;; Copyright (C) 1993, 1997 Free Software Foundation, Inc. +;; Copyright (C) 1993, 1997, 2002, 2003, 2004, +;; 2005 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 @@ -24,8 +25,8 @@ ;; 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 @@ -44,28 +45,28 @@ ;; 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) @@ -146,12 +147,14 @@ (...))) 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. @@ -160,6 +163,7 @@ (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. @@ -168,6 +172,7 @@ (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 @@ -213,6 +218,7 @@ "*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 @@ -223,6 +229,7 @@ "*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 @@ -239,10 +246,11 @@ "*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 @@ -346,7 +354,7 @@ (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 @@ -426,6 +434,7 @@ (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." @@ -481,6 +490,7 @@ 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. @@ -510,39 +520,15 @@ (defvar sc-attributions nil "Alist of attributions for use when citing.") -(defconst sc-emacs-features - (let ((version 'v18) - (flavor 'GNU)) - (if (not - (string= (substring emacs-version 0 2) "18")) - (setq version 'v19)) - (if (string-match "Lucid" emacs-version) - (setq flavor 'Lucid)) - ;; cobble up list - (list version flavor)) - "A list describing what version of Emacs we're running on. -Known flavors are: - -Emacs 18 : (v18 GNU) -Emacs 19 or later : (v19 GNU) -Lucid 19 or later : (v19 Lucid)") - - (defvar sc-tmp-nested-regexp nil - "Temporary regepx describing nested citations.") + "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) ;; ====================================================================== @@ -552,140 +538,82 @@ "*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)) ;; ====================================================================== ;; 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 @@ -704,30 +632,23 @@ ") ")) (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) @@ -738,19 +659,19 @@ ((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) @@ -800,8 +721,9 @@ (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) @@ -809,13 +731,12 @@ 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 () @@ -823,7 +744,7 @@ (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 () @@ -842,7 +763,7 @@ (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 () @@ -866,7 +787,8 @@ (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) @@ -884,7 +806,7 @@ 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 @@ -926,7 +848,7 @@ "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. @@ -938,7 +860,7 @@ key) (if (not action) () - (setq key (sc-completing-read + (setq key (completing-read (concat (car (rassq action alist)) " information key: ") sc-mail-info nil @@ -952,17 +874,15 @@ ((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)) )))) @@ -980,7 +900,7 @@ 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))))) @@ -989,7 +909,7 @@ "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 @@ -1000,21 +920,21 @@ "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) "") ))) @@ -1042,6 +962,7 @@ (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, @@ -1077,10 +998,10 @@ (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))) ))) @@ -1098,13 +1019,14 @@ 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)) @@ -1173,12 +1095,9 @@ (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 " ") @@ -1212,8 +1131,7 @@ 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.") @@ -1266,8 +1184,11 @@ (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")) ))) @@ -1325,11 +1246,11 @@ (progn (setq choice (if sc-attrib-or-cite - (sc-read-string + (read-string "Enter citation prefix: " citation 'sc-citation-confirmation-history) - (sc-completing-read + (completing-read "Complete attribution name: " query-alist nil nil (cons initial 0) @@ -1360,20 +1281,17 @@ (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))) )) @@ -1400,6 +1318,8 @@ 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) @@ -1426,14 +1346,14 @@ `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) @@ -1467,13 +1387,14 @@ 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))) @@ -1519,18 +1440,23 @@ 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))) @@ -1539,8 +1465,10 @@ 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))) @@ -1551,8 +1479,10 @@ (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))) @@ -1587,7 +1517,8 @@ (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)))))) @@ -1744,7 +1675,7 @@ (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) ))) @@ -1863,7 +1794,6 @@ (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) @@ -1872,8 +1802,7 @@ values are changed to nil." (message "%s changed from %s to %s" variable (symbol-value variable) - (set variable (not (symbol-value variable)))) - (sc-set-mode-string)) + (set variable (not (symbol-value variable))))) (defun sc-set-variable (var) "Set the Supercite VARIABLE. @@ -1886,41 +1815,35 @@ 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") @@ -1953,27 +1876,25 @@ (interactive) (describe-function 'sc-T-describe)) -(defun sc-set-mode-string () - "Update the minor mode string to show state of Supercite." - (setq sc-mode-string - (concat " SC" - (if (or sc-auto-fill-region-p - sc-fixup-whitespace-p) - ":" "") - (if sc-auto-fill-region-p "f" "") - (if sc-fixup-whitespace-p "w" "") - ))) - ;; ====================================================================== ;; published interface to mail and news readers +(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. @@ -1994,29 +1915,14 @@ 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)))) @@ -2061,9 +1967,7 @@ (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)) ;; ====================================================================== @@ -2077,7 +1981,7 @@ (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) @@ -2101,22 +2005,21 @@ (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)) @@ -2168,4 +2071,5 @@ (provide 'supercite) (run-hooks 'sc-load-hook) +;; arch-tag: a5d5bfa6-3bd5-4414-8c65-0afc83e45cd3 ;;; supercite.el ends here