Mercurial > emacs
comparison 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 |
comparison
equal
deleted
inserted
replaced
88154:8ce476d3ba36 | 88155:d7ddb3e565de |
---|---|
1 ;;; supercite.el --- minor mode for citing mail and news replies | 1 ;;; supercite.el --- minor mode for citing mail and news replies |
2 | 2 |
3 ;; Copyright (C) 1993, 1997 Free Software Foundation, Inc. | 3 ;; Copyright (C) 1993, 1997, 2002, 2003, 2004, |
4 | 4 ;; 2005 Free Software Foundation, Inc. |
5 ;; Author: 1993 Barry A. Warsaw, Century Computing, Inc. <bwarsaw@cen.com> | 5 |
6 ;; Maintainer: Mark Senn <mds@ecn.purdue.edu> | 6 ;; Author: 1993 Barry A. Warsaw <bwarsaw@python.org> |
7 ;; Maintainer: Glenn Morris <rgm@gnu.org> | |
7 ;; Created: February 1993 | 8 ;; Created: February 1993 |
8 ;; Last Modified: 1993/09/22 18:58:46 | 9 ;; Last Modified: 1993/09/22 18:58:46 |
9 ;; Keywords: mail, news | 10 ;; Keywords: mail, news |
10 | 11 |
11 ;; supercite.el revision: 3.54 | 12 ;; supercite.el revision: 3.54 |
22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | 23 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
23 ;; GNU General Public License for more details. | 24 ;; GNU General Public License for more details. |
24 | 25 |
25 ;; You should have received a copy of the GNU General Public License | 26 ;; You should have received a copy of the GNU General Public License |
26 ;; along with GNU Emacs; see the file COPYING. If not, write to the | 27 ;; along with GNU Emacs; see the file COPYING. If not, write to the |
27 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | 28 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
28 ;; Boston, MA 02111-1307, USA. | 29 ;; Boston, MA 02110-1301, USA. |
29 | 30 |
30 ;; LCD Archive Entry | 31 ;; LCD Archive Entry |
31 ;; supercite|Barry A. Warsaw|supercite-help@python.org | 32 ;; supercite|Barry A. Warsaw|supercite-help@python.org |
32 ;; |Mail and news reply citation package | 33 ;; |Mail and news reply citation package |
33 ;; |1993/09/22 18:58:46|3.1| | 34 ;; |1993/09/22 18:58:46|3.1| |
42 | 43 |
43 ;; start user configuration variables | 44 ;; start user configuration variables |
44 ;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv | 45 ;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv |
45 | 46 |
46 (defgroup supercite nil | 47 (defgroup supercite nil |
47 "Supercite package" | 48 "Supercite package." |
48 :prefix "sc-" | 49 :prefix "sc-" |
49 :group 'mail | 50 :group 'mail |
50 :group 'news) | 51 :group 'news) |
51 | 52 |
52 (defgroup supercite-frames nil | 53 (defgroup supercite-frames nil |
53 "Supercite (regi) frames" | 54 "Supercite (regi) frames." |
54 :prefix "sc-" | 55 :prefix "sc-" |
55 :group 'supercite) | 56 :group 'supercite) |
56 | 57 |
57 (defgroup supercite-attr nil | 58 (defgroup supercite-attr nil |
58 "Supercite attributions" | 59 "Supercite attributions." |
59 :prefix "sc-" | 60 :prefix "sc-" |
60 :group 'supercite) | 61 :group 'supercite) |
61 | 62 |
62 (defgroup supercite-cite nil | 63 (defgroup supercite-cite nil |
63 "Supercite citings" | 64 "Supercite citings." |
64 :prefix "sc-" | 65 :prefix "sc-" |
65 :group 'supercite) | 66 :group 'supercite) |
66 | 67 |
67 (defgroup supercite-hooks nil | 68 (defgroup supercite-hooks nil |
68 "Hooking into supercite" | 69 "Hooking into supercite." |
69 :prefix "sc-" | 70 :prefix "sc-" |
70 :group 'supercite) | 71 :group 'supercite) |
71 | 72 |
72 (defcustom sc-auto-fill-region-p t | 73 (defcustom sc-auto-fill-region-p t |
73 "*If non-nil, automatically fill each paragraph after it has been cited." | 74 "*If non-nil, automatically fill each paragraph after it has been cited." |
144 (INFOKEY ((REGEXP . FRAME) | 145 (INFOKEY ((REGEXP . FRAME) |
145 (REGEXP . FRAME) | 146 (REGEXP . FRAME) |
146 (...))) | 147 (...))) |
147 | 148 |
148 Where INFOKEY is a key for `sc-mail-field', REGEXP is a regular | 149 Where INFOKEY is a key for `sc-mail-field', REGEXP is a regular |
149 expression to match against the INFOKEY's value. FRAME is a citation | 150 expression to match against the INFOKEY's value. FRAME is |
150 frame, or a variable containing a citation frame." | 151 a citation frame, or a symbol that represents the name of |
152 a variable whose value is a citation frame." | |
151 :type '(repeat (list symbol (repeat (cons regexp | 153 :type '(repeat (list symbol (repeat (cons regexp |
152 (choice (repeat (repeat sexp)) | 154 (choice (repeat (repeat sexp)) |
153 symbol))))) | 155 symbol))))) |
154 :group 'supercite-frames) | 156 :group 'supercite-frames) |
157 (put 'sc-cite-frame-alist 'risky-local-variable t) | |
155 | 158 |
156 (defcustom sc-uncite-frame-alist '() | 159 (defcustom sc-uncite-frame-alist '() |
157 "*Alist for frame selection during unciting. | 160 "*Alist for frame selection during unciting. |
158 See the variable `sc-cite-frame-alist' for details." | 161 See the variable `sc-cite-frame-alist' for details." |
159 :type '(repeat (list symbol (repeat (cons regexp | 162 :type '(repeat (list symbol (repeat (cons regexp |
160 (choice (repeat (repeat sexp)) | 163 (choice (repeat (repeat sexp)) |
161 symbol))))) | 164 symbol))))) |
162 :group 'supercite-frames) | 165 :group 'supercite-frames) |
166 (put 'sc-uncite-frame-alist 'risky-local-variable t) | |
163 | 167 |
164 (defcustom sc-recite-frame-alist '() | 168 (defcustom sc-recite-frame-alist '() |
165 "*Alist for frame selection during reciting. | 169 "*Alist for frame selection during reciting. |
166 See the variable `sc-cite-frame-alist' for details." | 170 See the variable `sc-cite-frame-alist' for details." |
167 :type '(repeat (list symbol (repeat (cons regexp | 171 :type '(repeat (list symbol (repeat (cons regexp |
168 (choice (repeat (repeat sexp)) | 172 (choice (repeat (repeat sexp)) |
169 symbol))))) | 173 symbol))))) |
170 :group 'supercite-frames) | 174 :group 'supercite-frames) |
175 (put 'sc-recite-frame-alist 'risky-local-variable t) | |
171 | 176 |
172 (defcustom sc-default-cite-frame | 177 (defcustom sc-default-cite-frame |
173 '(;; initialize fill state and temporary variables when entering | 178 '(;; initialize fill state and temporary variables when entering |
174 ;; frame. this makes things run much faster | 179 ;; frame. this makes things run much faster |
175 (begin (progn | 180 (begin (progn |
211 (end (sc-fill-if-different "")) | 216 (end (sc-fill-if-different "")) |
212 ) | 217 ) |
213 "*Default REGI frame for citing a region." | 218 "*Default REGI frame for citing a region." |
214 :type '(repeat (repeat sexp)) | 219 :type '(repeat (repeat sexp)) |
215 :group 'supercite-frames) | 220 :group 'supercite-frames) |
221 (put 'sc-default-cite-frame 'risky-local-variable t) | |
216 | 222 |
217 (defcustom sc-default-uncite-frame | 223 (defcustom sc-default-uncite-frame |
218 '(;; do nothing on a blank line | 224 '(;; do nothing on a blank line |
219 ("^[ \t]*$" nil) | 225 ("^[ \t]*$" nil) |
220 ;; if the line is cited, uncite it | 226 ;; if the line is cited, uncite it |
221 ((sc-cite-regexp) (sc-uncite-line)) | 227 ((sc-cite-regexp) (sc-uncite-line)) |
222 ) | 228 ) |
223 "*Default REGI frame for unciting a region." | 229 "*Default REGI frame for unciting a region." |
224 :type '(repeat (repeat sexp)) | 230 :type '(repeat (repeat sexp)) |
225 :group 'supercite-frames) | 231 :group 'supercite-frames) |
232 (put 'sc-default-uncite-frame 'risky-local-variable t) | |
226 | 233 |
227 (defcustom sc-default-recite-frame | 234 (defcustom sc-default-recite-frame |
228 '(;; initialize fill state when entering frame | 235 '(;; initialize fill state when entering frame |
229 (begin (sc-fill-if-different)) | 236 (begin (sc-fill-if-different)) |
230 ;; do nothing on a blank line | 237 ;; do nothing on a blank line |
237 (end (sc-fill-if-different "")) | 244 (end (sc-fill-if-different "")) |
238 ) | 245 ) |
239 "*Default REGI frame for reciting a region." | 246 "*Default REGI frame for reciting a region." |
240 :type '(repeat (repeat sexp)) | 247 :type '(repeat (repeat sexp)) |
241 :group 'supercite-frames) | 248 :group 'supercite-frames) |
249 (put 'sc-default-recite-frame 'risky-local-variable t) | |
242 | 250 |
243 (defcustom sc-cite-region-limit t | 251 (defcustom sc-cite-region-limit t |
244 "*This variable controls automatic citation of yanked text. | 252 "*This variable controls automatic citation of yanked text. |
245 Legal values are: | 253 Valid values are: |
246 | 254 |
247 non-nil -- cite the entire region, regardless of its size | 255 non-nil -- cite the entire region, regardless of its size |
248 nil -- do not cite the region at all | 256 nil -- do not cite the region at all |
249 <integer> -- a number indicating the threshold for citation. When | 257 <integer> -- a number indicating the threshold for citation. When |
250 the number of lines in the region is greater than this | 258 the number of lines in the region is greater than this |
344 :type 'boolean | 352 :type 'boolean |
345 :group 'supercite) | 353 :group 'supercite) |
346 | 354 |
347 (defcustom sc-nuke-mail-headers 'all | 355 (defcustom sc-nuke-mail-headers 'all |
348 "*Controls mail header nuking. | 356 "*Controls mail header nuking. |
349 Used in conjunction with `sc-nuke-mail-header-list'. Legal values are: | 357 Used in conjunction with `sc-nuke-mail-header-list'. Valid values are: |
350 | 358 |
351 `all' -- nuke all mail headers | 359 `all' -- nuke all mail headers |
352 `none' -- don't nuke any mail headers | 360 `none' -- don't nuke any mail headers |
353 `specified' -- nuke headers specified in `sc-nuke-mail-header-list' | 361 `specified' -- nuke headers specified in `sc-nuke-mail-header-list' |
354 `keep' -- keep headers specified in `sc-nuke-mail-header-list'" | 362 `keep' -- keep headers specified in `sc-nuke-mail-header-list'" |
424 :type '(repeat (list string | 432 :type '(repeat (list string |
425 (repeat (cons regexp | 433 (repeat (cons regexp |
426 (choice (sexp :tag "List to eval") | 434 (choice (sexp :tag "List to eval") |
427 string))))) | 435 string))))) |
428 :group 'supercite-attr) | 436 :group 'supercite-attr) |
437 (put 'sc-attrib-selection-list 'risky-local-variable t) | |
429 | 438 |
430 (defcustom sc-attribs-preselect-hook nil | 439 (defcustom sc-attribs-preselect-hook nil |
431 "*Hook to run before selecting an attribution." | 440 "*Hook to run before selecting an attribution." |
432 :type 'hook | 441 :type 'hook |
433 :group 'supercite-attr | 442 :group 'supercite-attr |
479 The variable `sc-preferred-header-style' controls which function in | 488 The variable `sc-preferred-header-style' controls which function in |
480 this list is chosen for automatic reference header insertions. | 489 this list is chosen for automatic reference header insertions. |
481 Electric reference mode will cycle through this list of functions." | 490 Electric reference mode will cycle through this list of functions." |
482 :type '(repeat sexp) | 491 :type '(repeat sexp) |
483 :group 'supercite) | 492 :group 'supercite) |
493 (put 'sc-rewrite-header-list 'risky-local-variable t) | |
484 | 494 |
485 (defcustom sc-titlecue-regexp "\\s +-+\\s +" | 495 (defcustom sc-titlecue-regexp "\\s +-+\\s +" |
486 "*Regular expression describing the separator between names and titles. | 496 "*Regular expression describing the separator between names and titles. |
487 Set to nil to treat entire field as a name." | 497 Set to nil to treat entire field as a name." |
488 :type '(choice (const :tag "entire field as name" nil) | 498 :type '(choice (const :tag "entire field as name" nil) |
508 (defvar sc-mail-info nil | 518 (defvar sc-mail-info nil |
509 "Alist of mail header information gleaned from reply buffer.") | 519 "Alist of mail header information gleaned from reply buffer.") |
510 (defvar sc-attributions nil | 520 (defvar sc-attributions nil |
511 "Alist of attributions for use when citing.") | 521 "Alist of attributions for use when citing.") |
512 | 522 |
513 (defconst sc-emacs-features | |
514 (let ((version 'v18) | |
515 (flavor 'GNU)) | |
516 (if (not | |
517 (string= (substring emacs-version 0 2) "18")) | |
518 (setq version 'v19)) | |
519 (if (string-match "Lucid" emacs-version) | |
520 (setq flavor 'Lucid)) | |
521 ;; cobble up list | |
522 (list version flavor)) | |
523 "A list describing what version of Emacs we're running on. | |
524 Known flavors are: | |
525 | |
526 Emacs 18 : (v18 GNU) | |
527 Emacs 19 or later : (v19 GNU) | |
528 Lucid 19 or later : (v19 Lucid)") | |
529 | |
530 | |
531 (defvar sc-tmp-nested-regexp nil | 523 (defvar sc-tmp-nested-regexp nil |
532 "Temporary regepx describing nested citations.") | 524 "Temporary regexp describing nested citations.") |
533 (defvar sc-tmp-nonnested-regexp nil | 525 (defvar sc-tmp-nonnested-regexp nil |
534 "Temporary regexp describing non-nested citations.") | 526 "Temporary regexp describing non-nested citations.") |
535 (defvar sc-tmp-dumb-regexp nil | 527 (defvar sc-tmp-dumb-regexp nil |
536 "Temp regexp describing non-nested citation cited with a nesting citer.") | 528 "Temp regexp describing non-nested citation cited with a nesting citer.") |
537 | 529 |
538 (defvar sc-minor-mode nil | |
539 "Supercite minor mode on flag.") | |
540 (defvar sc-mode-string " SC" | |
541 "Supercite minor mode string.") | |
542 | |
543 (make-variable-buffer-local 'sc-mail-info) | 530 (make-variable-buffer-local 'sc-mail-info) |
544 (make-variable-buffer-local 'sc-attributions) | 531 (make-variable-buffer-local 'sc-attributions) |
545 (make-variable-buffer-local 'sc-minor-mode) | |
546 | 532 |
547 | 533 |
548 ;; ====================================================================== | 534 ;; ====================================================================== |
549 ;; supercite keymaps | 535 ;; supercite keymaps |
550 | 536 |
551 (defvar sc-mode-map-prefix "\C-c\C-p" | 537 (defvar sc-mode-map-prefix "\C-c\C-p" |
552 "*Key binding to install Supercite keymap. | 538 "*Key binding to install Supercite keymap. |
553 If this is nil, Supercite keymap is not installed.") | 539 If this is nil, Supercite keymap is not installed.") |
554 | 540 |
555 (defvar sc-T-keymap () | 541 (defvar sc-T-keymap |
542 (let ((map (make-sparse-keymap))) | |
543 (define-key map "a" 'sc-S-preferred-attribution-list) | |
544 (define-key map "b" 'sc-T-mail-nuke-blank-lines) | |
545 (define-key map "c" 'sc-T-confirm-always) | |
546 (define-key map "d" 'sc-T-downcase) | |
547 (define-key map "e" 'sc-T-electric-references) | |
548 (define-key map "f" 'sc-T-auto-fill-region) | |
549 (define-key map "h" 'sc-T-describe) | |
550 (define-key map "l" 'sc-S-cite-region-limit) | |
551 (define-key map "n" 'sc-S-mail-nuke-mail-headers) | |
552 (define-key map "N" 'sc-S-mail-header-nuke-list) | |
553 (define-key map "o" 'sc-T-electric-circular) | |
554 (define-key map "p" 'sc-S-preferred-header-style) | |
555 (define-key map "s" 'sc-T-nested-citation) | |
556 (define-key map "u" 'sc-T-use-only-preferences) | |
557 (define-key map "w" 'sc-T-fixup-whitespace) | |
558 (define-key map "?" 'sc-T-describe) | |
559 map) | |
556 "Keymap for sub-keymap of setting and toggling functions.") | 560 "Keymap for sub-keymap of setting and toggling functions.") |
557 (if sc-T-keymap | 561 |
558 () | 562 (defvar sc-mode-map |
559 (setq sc-T-keymap (make-sparse-keymap)) | 563 (let ((map (make-sparse-keymap))) |
560 (define-key sc-T-keymap "a" 'sc-S-preferred-attribution-list) | 564 (define-key map "c" 'sc-cite-region) |
561 (define-key sc-T-keymap "b" 'sc-T-mail-nuke-blank-lines) | 565 (define-key map "f" 'sc-mail-field-query) |
562 (define-key sc-T-keymap "c" 'sc-T-confirm-always) | 566 (define-key map "g" 'sc-mail-process-headers) |
563 (define-key sc-T-keymap "d" 'sc-T-downcase) | 567 (define-key map "h" 'sc-describe) |
564 (define-key sc-T-keymap "e" 'sc-T-electric-references) | 568 (define-key map "i" 'sc-insert-citation) |
565 (define-key sc-T-keymap "f" 'sc-T-auto-fill-region) | 569 (define-key map "o" 'sc-open-line) |
566 (define-key sc-T-keymap "h" 'sc-T-describe) | 570 (define-key map "r" 'sc-recite-region) |
567 (define-key sc-T-keymap "l" 'sc-S-cite-region-limit) | 571 (define-key map "\C-p" 'sc-raw-mode-toggle) |
568 (define-key sc-T-keymap "n" 'sc-S-mail-nuke-mail-headers) | 572 (define-key map "u" 'sc-uncite-region) |
569 (define-key sc-T-keymap "N" 'sc-S-mail-header-nuke-list) | 573 (define-key map "v" 'sc-version) |
570 (define-key sc-T-keymap "o" 'sc-T-electric-circular) | 574 (define-key map "w" 'sc-insert-reference) |
571 (define-key sc-T-keymap "p" 'sc-S-preferred-header-style) | 575 (define-key map "\C-t" sc-T-keymap) |
572 (define-key sc-T-keymap "s" 'sc-T-nested-citation) | 576 (define-key map "\C-b" 'sc-submit-bug-report) |
573 (define-key sc-T-keymap "u" 'sc-T-use-only-preferences) | 577 (define-key map "?" 'sc-describe) |
574 (define-key sc-T-keymap "w" 'sc-T-fixup-whitespace) | 578 map) |
575 (define-key sc-T-keymap "?" 'sc-T-describe) | |
576 ) | |
577 | |
578 (defvar sc-mode-map () | |
579 "Keymap for Supercite quasi-mode.") | 579 "Keymap for Supercite quasi-mode.") |
580 (if sc-mode-map | 580 |
581 () | 581 (defvar sc-electric-mode-map |
582 (setq sc-mode-map (make-sparse-keymap)) | 582 (let ((map (make-sparse-keymap))) |
583 (define-key sc-mode-map "c" 'sc-cite-region) | 583 (define-key map "p" 'sc-eref-prev) |
584 (define-key sc-mode-map "f" 'sc-mail-field-query) | 584 (define-key map "n" 'sc-eref-next) |
585 (define-key sc-mode-map "g" 'sc-mail-process-headers) | 585 (define-key map "s" 'sc-eref-setn) |
586 (define-key sc-mode-map "h" 'sc-describe) | 586 (define-key map "j" 'sc-eref-jump) |
587 (define-key sc-mode-map "i" 'sc-insert-citation) | 587 (define-key map "x" 'sc-eref-abort) |
588 (define-key sc-mode-map "o" 'sc-open-line) | 588 (define-key map "q" 'sc-eref-abort) |
589 (define-key sc-mode-map "r" 'sc-recite-region) | 589 (define-key map "\r" 'sc-eref-exit) |
590 (define-key sc-mode-map "\C-p" 'sc-raw-mode-toggle) | 590 (define-key map "\n" 'sc-eref-exit) |
591 (define-key sc-mode-map "u" 'sc-uncite-region) | 591 (define-key map "g" 'sc-eref-goto) |
592 (define-key sc-mode-map "v" 'sc-version) | 592 (define-key map "?" 'describe-mode) |
593 (define-key sc-mode-map "w" 'sc-insert-reference) | 593 (define-key map "\C-h" 'describe-mode) |
594 (define-key sc-mode-map "\C-t" sc-T-keymap) | 594 (define-key map [f1] 'describe-mode) |
595 (define-key sc-mode-map "\C-b" 'sc-submit-bug-report) | 595 (define-key map [help] 'describe-mode) |
596 (define-key sc-mode-map "?" 'sc-describe) | 596 map) |
597 ) | |
598 | |
599 (defvar sc-electric-mode-map () | |
600 "Keymap for `sc-electric-mode' electric references mode.") | 597 "Keymap for `sc-electric-mode' electric references mode.") |
601 (if sc-electric-mode-map | 598 |
602 nil | 599 |
603 (setq sc-electric-mode-map (make-sparse-keymap)) | 600 (defvar sc-minibuffer-local-completion-map |
604 (define-key sc-electric-mode-map "p" 'sc-eref-prev) | 601 (let ((map (copy-keymap minibuffer-local-completion-map))) |
605 (define-key sc-electric-mode-map "n" 'sc-eref-next) | 602 (define-key map "\C-t" 'sc-toggle-fn) |
606 (define-key sc-electric-mode-map "s" 'sc-eref-setn) | 603 (define-key map " " 'self-insert-command) |
607 (define-key sc-electric-mode-map "j" 'sc-eref-jump) | 604 map) |
608 (define-key sc-electric-mode-map "x" 'sc-eref-abort) | |
609 (define-key sc-electric-mode-map "q" 'sc-eref-abort) | |
610 (define-key sc-electric-mode-map "\r" 'sc-eref-exit) | |
611 (define-key sc-electric-mode-map "\n" 'sc-eref-exit) | |
612 (define-key sc-electric-mode-map "g" 'sc-eref-goto) | |
613 (define-key sc-electric-mode-map "?" 'describe-mode) | |
614 (define-key sc-electric-mode-map "\C-h" 'describe-mode) | |
615 (define-key sc-electric-mode-map [f1] 'describe-mode) | |
616 (define-key sc-electric-mode-map [help] 'describe-mode) | |
617 ) | |
618 | |
619 (defvar sc-minibuffer-local-completion-map nil | |
620 "Keymap for minibuffer confirmation of attribution strings.") | 605 "Keymap for minibuffer confirmation of attribution strings.") |
621 (if sc-minibuffer-local-completion-map | 606 |
622 () | 607 (defvar sc-minibuffer-local-map |
623 (setq sc-minibuffer-local-completion-map | 608 (let ((map (copy-keymap minibuffer-local-map))) |
624 (copy-keymap minibuffer-local-completion-map)) | 609 (define-key map "\C-t" 'sc-toggle-fn) |
625 (define-key sc-minibuffer-local-completion-map "\C-t" 'sc-toggle-fn) | 610 map) |
626 (define-key sc-minibuffer-local-completion-map " " 'self-insert-command)) | |
627 | |
628 (defvar sc-minibuffer-local-map nil | |
629 "Keymap for minibuffer confirmation of attribution strings.") | 611 "Keymap for minibuffer confirmation of attribution strings.") |
630 (if sc-minibuffer-local-map | |
631 () | |
632 (setq sc-minibuffer-local-map (copy-keymap minibuffer-local-map)) | |
633 (define-key sc-minibuffer-local-map "\C-t" 'sc-toggle-fn)) | |
634 | 612 |
635 | 613 |
636 ;; ====================================================================== | 614 ;; ====================================================================== |
637 ;; utility functions | 615 ;; utility functions |
638 | |
639 (defun sc-completing-read (prompt table &optional predicate require-match | |
640 initial-contents history) | |
641 "Compatibility between Emacs 18 and 19 `completing-read'. | |
642 In version 18, the HISTORY argument is ignored." | |
643 (if (memq 'v19 sc-emacs-features) | |
644 (funcall 'completing-read prompt table predicate require-match | |
645 initial-contents history) | |
646 (funcall 'completing-read prompt table predicate require-match | |
647 (or (car-safe initial-contents) | |
648 initial-contents)))) | |
649 | |
650 (defun sc-read-string (prompt &optional initial-contents history) | |
651 "Compatibility between Emacs 18 and 19 `read-string'. | |
652 In version 18, the HISTORY argument is ignored." | |
653 (if (memq 'v19 sc-emacs-features) | |
654 (read-string prompt initial-contents history) | |
655 (read-string prompt initial-contents))) | |
656 | |
657 (if (fboundp 'match-string) | |
658 (defalias 'sc-submatch 'match-string) | |
659 (defun sc-submatch (matchnum &optional string) | |
660 "Returns `match-beginning' and `match-end' sub-expression for MATCHNUM. | |
661 If optional STRING is provided, take sub-expression using `substring' | |
662 of argument, otherwise use `buffer-substring' on current buffer. Note | |
663 that `match-data' must have already been generated and no error | |
664 checking is performed by this function." | |
665 (if string | |
666 (substring string (match-beginning matchnum) (match-end matchnum)) | |
667 (buffer-substring (match-beginning matchnum) (match-end matchnum))))) | |
668 | |
669 (if (fboundp 'member) | |
670 (defalias 'sc-member 'member) | |
671 (defun sc-member (elt list) | |
672 "Like `memq', but uses `equal' instead of `eq'. | |
673 Emacs19 has a builtin function `member' which does exactly this." | |
674 (catch 'elt-is-member | |
675 (while list | |
676 (if (equal elt (car list)) | |
677 (throw 'elt-is-member list)) | |
678 (setq list (cdr list)))))) | |
679 | |
680 ;; One day maybe Emacs will have this... | |
681 (if (fboundp 'string-text) | |
682 (defalias 'sc-string-text 'string-text) | |
683 (defun sc-string-text (string) | |
684 "Return STRING with all text properties removed." | |
685 (let ((string (copy-sequence string))) | |
686 (set-text-properties 0 (length string) nil string) | |
687 string))) | |
688 | 616 |
689 (defun sc-ask (alist) | 617 (defun sc-ask (alist) |
690 "Ask a question in the minibuffer requiring a single character answer. | 618 "Ask a question in the minibuffer requiring a single character answer. |
691 This function is kind of an extension of `y-or-n-p' where a single | 619 This function is kind of an extension of `y-or-n-p' where a single |
692 letter is used to answer a question. Question is formed from ALIST | 620 letter is used to answer a question. Question is formed from ALIST |
702 (function | 630 (function |
703 (lambda (elt) (char-to-string (cdr elt)))) alist "/") | 631 (lambda (elt) (char-to-string (cdr elt)))) alist "/") |
704 ") ")) | 632 ") ")) |
705 (p prompt) | 633 (p prompt) |
706 (event | 634 (event |
707 (if (memq 'Lucid sc-emacs-features) | 635 (if (fboundp 'allocate-event) |
708 (allocate-event) | 636 (allocate-event) |
709 nil))) | 637 nil))) |
710 (while (stringp p) | 638 (while (stringp p) |
711 (if (let ((cursor-in-echo-area t) | 639 (if (let ((cursor-in-echo-area t) |
712 (inhibit-quit t)) | 640 (inhibit-quit t)) |
713 (message "%s" p) | 641 (message "%s" p) |
714 ;; lets be good neighbors and be compatible with all emacsen | 642 (setq event (read-event)) |
715 (cond | |
716 ((memq 'v18 sc-emacs-features) | |
717 (setq event (read-char))) | |
718 ((memq 'Lucid sc-emacs-features) | |
719 (next-command-event event)) | |
720 (t ; must be Emacs 19 | |
721 (setq event (read-event)))) | |
722 (prog1 quit-flag (setq quit-flag nil))) | 643 (prog1 quit-flag (setq quit-flag nil))) |
723 (progn | 644 (progn |
724 (message "%s%s" p (single-key-description event)) | 645 (message "%s%s" p (single-key-description event)) |
725 (and (memq 'Lucid sc-emacs-features) | 646 (if (fboundp 'deallocate-event) |
726 (deallocate-event event)) | 647 (deallocate-event event)) |
727 (setq quit-flag nil) | 648 (setq quit-flag nil) |
728 (signal 'quit '()))) | 649 (signal 'quit '()))) |
729 (let ((char | 650 (let ((char |
730 (if (memq 'Lucid sc-emacs-features) | 651 (if (featurep 'xemacs) |
731 (let* ((key (and (key-press-event-p event) (event-key event))) | 652 (let* ((key (and (key-press-event-p event) (event-key event))) |
732 (char (and key (event-to-character event)))) | 653 (char (and key (event-to-character event)))) |
733 char) | 654 char) |
734 event)) | 655 event)) |
735 elt) | 656 elt) |
736 (if char (setq char (downcase char))) | 657 (if char (setq char (downcase char))) |
737 (cond | 658 (cond |
738 ((setq elt (rassq char alist)) | 659 ((setq elt (rassq char alist)) |
739 (message "%s%s" p (car elt)) | 660 (message "%s%s" p (car elt)) |
740 (setq p (cdr elt))) | 661 (setq p (cdr elt))) |
741 ((and (memq 'Lucid sc-emacs-features) | 662 ((if (fboundp 'button-release-event-p) |
742 (button-release-event-p event)) ; ignore them | 663 (button-release-event-p event)) ; ignore them |
743 nil) | 664 nil) |
744 (t | 665 (t |
745 (message "%s%s" p (single-key-description event)) | 666 (message "%s%s" p (single-key-description event)) |
746 (if (memq 'Lucid sc-emacs-features) | 667 (if (featurep 'xemacs) |
747 (ding nil 'y-or-n-p) | 668 (ding nil 'y-or-n-p) |
748 (ding)) | 669 (ding)) |
749 (discard-input) | 670 (discard-input) |
750 (if (eq p prompt) | 671 (if (eq p prompt) |
751 (setq p (concat "Try again. " prompt))))))) | 672 (setq p (concat "Try again. " prompt))))))) |
752 (and (memq 'Lucid sc-emacs-features) | 673 (if (fboundp 'deallocate-event) |
753 (deallocate-event event)) | 674 (deallocate-event event)) |
754 p)) | 675 p)) |
755 | 676 |
756 (defun sc-scan-info-alist (alist) | 677 (defun sc-scan-info-alist (alist) |
757 "Find a match in the info alist that matches a regexp in ALIST." | 678 "Find a match in the info alist that matches a regexp in ALIST." |
758 (let ((sc-mumble "") | 679 (let ((sc-mumble "") |
798 ("^$" (list 'abort '(step . 0))) | 719 ("^$" (list 'abort '(step . 0))) |
799 ("^[ \t]+" (sc-mail-append-field)) | 720 ("^[ \t]+" (sc-mail-append-field)) |
800 (sc-mail-warn-if-non-rfc822-p (sc-mail-error-in-mail-field)) | 721 (sc-mail-warn-if-non-rfc822-p (sc-mail-error-in-mail-field)) |
801 (end (setq sc-mail-headers-end (point)))) | 722 (end (setq sc-mail-headers-end (point)))) |
802 "Regi frame for glomming mail header information.") | 723 "Regi frame for glomming mail header information.") |
803 | 724 (put 'sc-mail-glom-frame 'risky-local-variable t) |
804 (eval-when-compile (defvar curline)) ; dynamic bondage | 725 |
726 (defvar curline) ; dynamic bondage | |
805 | 727 |
806 ;; regi functions | 728 ;; regi functions |
807 (defun sc-mail-fetch-field (&optional attribs-p) | 729 (defun sc-mail-fetch-field (&optional attribs-p) |
808 "Insert a key and value into `sc-mail-info' alist. | 730 "Insert a key and value into `sc-mail-info' alist. |
809 If optional ATTRIBS-P is non-nil, the key/value pair is placed in | 731 If optional ATTRIBS-P is non-nil, the key/value pair is placed in |
810 `sc-attributions' too." | 732 `sc-attributions' too." |
811 (if (string-match "^\\(\\S *\\)\\s *:\\s +\\(.*\\)$" curline) | 733 (if (string-match "^\\(\\S *\\)\\s *:\\s +\\(.*\\)$" curline) |
812 (let* ((key (downcase (sc-string-text (sc-submatch 1 curline)))) | 734 (let* ((key (downcase (match-string-no-properties 1 curline))) |
813 (val (sc-string-text (sc-submatch 2 curline))) | 735 (val (match-string-no-properties 2 curline)) |
814 (keyval (cons key val))) | 736 (keyval (cons key val))) |
815 (setq sc-mail-info (cons keyval sc-mail-info)) | 737 (push keyval sc-mail-info) |
816 (if attribs-p | 738 (if attribs-p |
817 (setq sc-attributions (cons keyval sc-attributions))) | 739 (push keyval sc-attributions)))) |
818 )) | |
819 nil) | 740 nil) |
820 | 741 |
821 (defun sc-mail-append-field () | 742 (defun sc-mail-append-field () |
822 "Append a continuation line onto the last fetched mail field's info." | 743 "Append a continuation line onto the last fetched mail field's info." |
823 (let ((keyval (car sc-mail-info))) | 744 (let ((keyval (car sc-mail-info))) |
824 (if (and keyval (string-match "^\\s *\\(.*\\)$" curline)) | 745 (if (and keyval (string-match "^\\s *\\(.*\\)$" curline)) |
825 (setcdr keyval (concat (cdr keyval) " " | 746 (setcdr keyval (concat (cdr keyval) " " |
826 (sc-string-text (sc-submatch 1 curline)))))) | 747 (match-string-no-properties 1 curline))))) |
827 nil) | 748 nil) |
828 | 749 |
829 (defun sc-mail-error-in-mail-field () | 750 (defun sc-mail-error-in-mail-field () |
830 "Issue warning that mail headers don't conform to RFC 822." | 751 "Issue warning that mail headers don't conform to RFC 822." |
831 (let* ((len (min (length curline) 10)) | 752 (let* ((len (min (length curline) 10)) |
840 (defvar sc-mail-last-header-nuked-p nil | 761 (defvar sc-mail-last-header-nuked-p nil |
841 "True if the last header was nuked.") | 762 "True if the last header was nuked.") |
842 | 763 |
843 (defun sc-mail-nuke-line () | 764 (defun sc-mail-nuke-line () |
844 "Nuke the current mail header line." | 765 "Nuke the current mail header line." |
845 (delete-region (regi-pos 'bol) (regi-pos 'bonl)) | 766 (delete-region (line-beginning-position) (line-beginning-position 2)) |
846 '((step . -1))) | 767 '((step . -1))) |
847 | 768 |
848 (defun sc-mail-nuke-header-line () | 769 (defun sc-mail-nuke-header-line () |
849 "Delete current-line and set up for possible continuation." | 770 "Delete current-line and set up for possible continuation." |
850 (setq sc-mail-last-header-nuked-p t) | 771 (setq sc-mail-last-header-nuked-p t) |
864 (skip-chars-backward " \t\n") | 785 (skip-chars-backward " \t\n") |
865 (forward-line 1) | 786 (forward-line 1) |
866 (delete-blank-lines) | 787 (delete-blank-lines) |
867 (beginning-of-line) | 788 (beginning-of-line) |
868 (if (looking-at "[ \t]*$") | 789 (if (looking-at "[ \t]*$") |
869 (delete-region (regi-pos 'bol) (regi-pos 'bonl))) | 790 (delete-region (line-beginning-position) |
791 (line-beginning-position 2))) | |
870 (insert-char ?\n sc-blank-lines-after-headers))) | 792 (insert-char ?\n sc-blank-lines-after-headers))) |
871 nil) | 793 nil) |
872 | 794 |
873 (defun sc-mail-build-nuke-frame () | 795 (defun sc-mail-build-nuke-frame () |
874 "Build the regiframe for nuking mail headers." | 796 "Build the regiframe for nuking mail headers." |
882 ((eq sc-nuke-mail-headers 'keep) | 804 ((eq sc-nuke-mail-headers 'keep) |
883 (setq entry-func '(setq sc-mail-last-header-nuked-p nil) | 805 (setq entry-func '(setq sc-mail-last-header-nuked-p nil) |
884 nonentry-func '(sc-mail-nuke-header-line))) | 806 nonentry-func '(sc-mail-nuke-header-line))) |
885 ;; we never get far enough to interpret a frame if s-n-m-h == 'none | 807 ;; we never get far enough to interpret a frame if s-n-m-h == 'none |
886 ((eq sc-nuke-mail-headers 'none)) | 808 ((eq sc-nuke-mail-headers 'none)) |
887 (t (error "Illegal value for sc-nuke-mail-headers: %s" | 809 (t (error "Invalid value for sc-nuke-mail-headers: %s" |
888 sc-nuke-mail-headers)) | 810 sc-nuke-mail-headers)) |
889 ) ; end-cond | 811 ) ; end-cond |
890 (append | 812 (append |
891 (and entry-func | 813 (and entry-func |
892 (regi-mapcar sc-nuke-mail-header-list entry-func nil t)) | 814 (regi-mapcar sc-nuke-mail-header-list entry-func nil t)) |
924 ;; let the user change mail field information | 846 ;; let the user change mail field information |
925 (defun sc-mail-field (field) | 847 (defun sc-mail-field (field) |
926 "Return the mail header field value associated with FIELD. | 848 "Return the mail header field value associated with FIELD. |
927 If there was no mail header with FIELD as its key, return the value of | 849 If there was no mail header with FIELD as its key, return the value of |
928 `sc-mumble'. FIELD is case insensitive." | 850 `sc-mumble'. FIELD is case insensitive." |
929 (or (cdr (assoc (downcase field) sc-mail-info)) sc-mumble)) | 851 (or (cdr (assoc-string field sc-mail-info 'case-fold)) sc-mumble)) |
930 | 852 |
931 (defun sc-mail-field-query (arg) | 853 (defun sc-mail-field-query (arg) |
932 "View the value of a mail field. | 854 "View the value of a mail field. |
933 With `\\[universal-argument]', prompts for action on mail field. | 855 With `\\[universal-argument]', prompts for action on mail field. |
934 Action can be one of: View, Modify, Add, or Delete." | 856 Action can be one of: View, Modify, Add, or Delete." |
936 (let* ((alist '(("view" . ?v) ("modify" . ?m) ("add" . ?a) ("delete" . ?d))) | 858 (let* ((alist '(("view" . ?v) ("modify" . ?m) ("add" . ?a) ("delete" . ?d))) |
937 (action (if (not arg) ?v (sc-ask alist))) | 859 (action (if (not arg) ?v (sc-ask alist))) |
938 key) | 860 key) |
939 (if (not action) | 861 (if (not action) |
940 () | 862 () |
941 (setq key (sc-completing-read | 863 (setq key (completing-read |
942 (concat (car (rassq action alist)) | 864 (concat (car (rassq action alist)) |
943 " information key: ") | 865 " information key: ") |
944 sc-mail-info nil | 866 sc-mail-info nil |
945 (if (eq action ?a) nil 'noexit) | 867 (if (eq action ?a) nil 'noexit) |
946 nil 'sc-mail-field-history)) | 868 nil 'sc-mail-field-history)) |
950 ((eq action ?d) | 872 ((eq action ?d) |
951 (setq sc-mail-info (delq (assoc key sc-mail-info) sc-mail-info))) | 873 (setq sc-mail-info (delq (assoc key sc-mail-info) sc-mail-info))) |
952 ((eq action ?m) | 874 ((eq action ?m) |
953 (let ((keyval (assoc key sc-mail-info))) | 875 (let ((keyval (assoc key sc-mail-info))) |
954 ;; first put initial value onto list if not already there | 876 ;; first put initial value onto list if not already there |
955 (if (not (sc-member (cdr keyval) | 877 (if (not (member (cdr keyval) |
956 sc-mail-field-modification-history)) | 878 sc-mail-field-modification-history)) |
957 (setq sc-mail-field-modification-history | 879 (setq sc-mail-field-modification-history |
958 (cons (cdr keyval) sc-mail-field-modification-history))) | 880 (cons (cdr keyval) sc-mail-field-modification-history))) |
959 (setcdr keyval (sc-read-string | 881 (setcdr keyval (read-string |
960 (concat key ": ") (cdr keyval) | 882 (concat key ": ") (cdr keyval) |
961 'sc-mail-field-modification-history)))) | 883 'sc-mail-field-modification-history)))) |
962 ((eq action ?a) | 884 ((eq action ?a) |
963 (setq sc-mail-info | 885 (push (cons key (read-string (concat key ": "))) sc-mail-info)) |
964 (cons (cons key | |
965 (sc-read-string (concat key ": "))) sc-mail-info))) | |
966 )))) | 886 )))) |
967 | 887 |
968 | 888 |
969 ;; ====================================================================== | 889 ;; ====================================================================== |
970 ;; attributions | 890 ;; attributions |
978 "Extract the author's email terminus from email address FROM. | 898 "Extract the author's email terminus from email address FROM. |
979 Match addresses of the style ``name%[stuff].'' when called with DELIM | 899 Match addresses of the style ``name%[stuff].'' when called with DELIM |
980 of \"%\" and addresses of the style ``[stuff]name@[stuff]'' when | 900 of \"%\" and addresses of the style ``[stuff]name@[stuff]'' when |
981 called with DELIM \"@\". If DELIM is nil or not provided, matches | 901 called with DELIM \"@\". If DELIM is nil or not provided, matches |
982 addresses of the style ``name''." | 902 addresses of the style ``name''." |
983 (and (string-match (concat "[-a-zA-Z0-9_.]+" delim) from 0) | 903 (and (string-match (concat "[-[:alnum:]_.]+" delim) from 0) |
984 (substring from | 904 (substring from |
985 (match-beginning 0) | 905 (match-beginning 0) |
986 (- (match-end 0) (if (null delim) 0 1))))) | 906 (- (match-end 0) (if (null delim) 0 1))))) |
987 | 907 |
988 (defun sc-attribs-!-addresses (from) | 908 (defun sc-attribs-!-addresses (from) |
989 "Extract the author's email terminus from email address FROM. | 909 "Extract the author's email terminus from email address FROM. |
990 Match addresses of the style ``[stuff]![stuff]...!name[stuff].''" | 910 Match addresses of the style ``[stuff]![stuff]...!name[stuff].''" |
991 (let ((eos (length from)) | 911 (let ((eos (length from)) |
992 (mstart (string-match "![-a-zA-Z0-9_.]+\\([^-!a-zA-Z0-9_.]\\|$\\)" | 912 (mstart (string-match "![-[:alnum:]_.]+\\([^-![:alnum:]_.]\\|$\\)" |
993 from 0)) | 913 from 0)) |
994 (mend (match-end 0))) | 914 (mend (match-end 0))) |
995 (and mstart | 915 (and mstart |
996 (substring from (1+ mstart) (- mend (if (= mend eos) 0 1))) | 916 (substring from (1+ mstart) (- mend (if (= mend eos) 0 1))) |
997 ))) | 917 ))) |
998 | 918 |
999 (defun sc-attribs-<>-addresses (from) | 919 (defun sc-attribs-<>-addresses (from) |
1000 "Extract the author's email terminus from email address FROM. | 920 "Extract the author's email terminus from email address FROM. |
1001 Match addresses of the style ``<name[stuff]>.''" | 921 Match addresses of the style ``<name[stuff]>.''" |
1002 (and (string-match "<\\(.*\\)>" from) | 922 (and (string-match "<\\(.*\\)>" from) |
1003 (sc-submatch 1 from))) | 923 (match-string 1 from))) |
1004 | 924 |
1005 (defun sc-get-address (from author) | 925 (defun sc-get-address (from author) |
1006 "Get the full email address path from FROM. | 926 "Get the full email address path from FROM. |
1007 AUTHOR is the author's name (which is removed from the address)." | 927 AUTHOR is the author's name (which is removed from the address)." |
1008 (let ((eos (length from))) | 928 (let ((eos (length from))) |
1009 (if (string-match (concat "\\(^\\|^\"\\)" author | 929 (if (string-match (concat "\\`\"?" (regexp-quote author) |
1010 "\\(\\s +\\|\"\\s +\\)") from 0) | 930 "\"?\\s +") from 0) |
1011 (let ((address (substring from (match-end 0) eos))) | 931 (let ((address (substring from (match-end 0) eos))) |
1012 (if (and (= (aref address 0) ?<) | 932 (if (and (= (aref address 0) ?<) |
1013 (= (aref address (1- (length address))) ?>)) | 933 (= (aref address (1- (length address))) ?>)) |
1014 (substring address 1 (1- (length address))) | 934 (substring address 1 (1- (length address))) |
1015 address)) | 935 address)) |
1016 (if (string-match "[-[:alnum:]!@%._]+" from 0) | 936 (if (string-match "[-[:alnum:]!@%._]+" from 0) |
1017 (sc-submatch 0 from) | 937 (match-string 0 from) |
1018 "") | 938 "") |
1019 ))) | 939 ))) |
1020 | 940 |
1021 (defun sc-attribs-emailname (from) | 941 (defun sc-attribs-emailname (from) |
1022 "Get the email terminus name from FROM." | 942 "Get the email terminus name from FROM." |
1040 )))) | 960 )))) |
1041 | 961 |
1042 (defun sc-attribs-extract-namestring (from) | 962 (defun sc-attribs-extract-namestring (from) |
1043 "Extract the name string from FROM. | 963 "Extract the name string from FROM. |
1044 This should be the author's full name minus an optional title." | 964 This should be the author's full name minus an optional title." |
965 ;; FIXME: we probably should use mail-extract-address-components. | |
1045 (let ((namestring | 966 (let ((namestring |
1046 (or | 967 (or |
1047 ;; If there is a <...> in the name, | 968 ;; If there is a <...> in the name, |
1048 ;; treat everything before that as the full name. | 969 ;; treat everything before that as the full name. |
1049 ;; Even if it contains parens, use the whole thing. | 970 ;; Even if it contains parens, use the whole thing. |
1075 (setq eos (1- eos))) | 996 (setq eos (1- eos))) |
1076 (substring namestring bos (1+ eos)))))) | 997 (substring namestring bos (1+ eos)))))) |
1077 | 998 |
1078 (defun sc-attribs-chop-namestring (namestring) | 999 (defun sc-attribs-chop-namestring (namestring) |
1079 "Convert NAMESTRING to a list of names. | 1000 "Convert NAMESTRING to a list of names. |
1080 example: (sc-namestring-to-list \"John Xavier Doe\") | 1001 example: (sc-attribs-chop-namestring \"John Xavier Doe\") |
1081 => (\"John\" \"Xavier\" \"Doe\")" | 1002 => (\"John\" \"Xavier\" \"Doe\")" |
1082 (if (string-match "\\([ \t]*\\)\\([^ \t._]+\\)\\([ \t]*\\)" namestring) | 1003 (if (string-match "\\([ \t]*\\)\\([^ \t._]+\\)\\([ \t]*\\)" namestring) |
1083 (cons (sc-submatch 2 namestring) | 1004 (cons (match-string 2 namestring) |
1084 (sc-attribs-chop-namestring (substring namestring (match-end 3))) | 1005 (sc-attribs-chop-namestring (substring namestring (match-end 3))) |
1085 ))) | 1006 ))) |
1086 | 1007 |
1087 (defun sc-attribs-strip-initials (namelist) | 1008 (defun sc-attribs-strip-initials (namelist) |
1088 "Extract the author's initials from the NAMELIST." | 1009 "Extract the author's initials from the NAMELIST." |
1096 (defun sc-guess-attribution (&optional string) | 1017 (defun sc-guess-attribution (&optional string) |
1097 "Guess attribution string on current line. | 1018 "Guess attribution string on current line. |
1098 If attribution cannot be guessed, nil is returned. Optional STRING if | 1019 If attribution cannot be guessed, nil is returned. Optional STRING if |
1099 supplied, is used instead of the line point is on in the current buffer." | 1020 supplied, is used instead of the line point is on in the current buffer." |
1100 (let ((start 0) | 1021 (let ((start 0) |
1101 (string (or string (buffer-substring (regi-pos 'bol) (regi-pos 'eol)))) | 1022 (string (or string (buffer-substring (line-beginning-position) |
1023 (line-end-position)))) | |
1102 attribution) | 1024 attribution) |
1103 (and | 1025 (and |
1104 (= start (or (string-match sc-citation-leader-regexp string start) -1)) | 1026 (= start (or (string-match sc-citation-leader-regexp string start) -1)) |
1105 (setq start (match-end 0)) | 1027 (setq start (match-end 0)) |
1106 (= start (or (string-match sc-citation-root-regexp string start) 1)) | 1028 (= start (or (string-match sc-citation-root-regexp string start) 1)) |
1107 (setq attribution (sc-submatch 0 string) | 1029 (setq attribution (match-string 0 string) |
1108 start (match-end 0)) | 1030 start (match-end 0)) |
1109 (= start (or (string-match sc-citation-delimiter-regexp string start) -1)) | 1031 (= start (or (string-match sc-citation-delimiter-regexp string start) -1)) |
1110 (setq start (match-end 0)) | 1032 (setq start (match-end 0)) |
1111 (= start (or (string-match sc-citation-separator-regexp string start) -1)) | 1033 (= start (or (string-match sc-citation-separator-regexp string start) -1)) |
1112 attribution))) | 1034 attribution))) |
1171 middlenames (mapconcat | 1093 middlenames (mapconcat |
1172 (function | 1094 (function |
1173 (lambda (midname) | 1095 (lambda (midname) |
1174 (let ((key-attribs (format "middlename-%d" n)) | 1096 (let ((key-attribs (format "middlename-%d" n)) |
1175 (key-mail (format "sc-middlename-%d" n))) | 1097 (key-mail (format "sc-middlename-%d" n))) |
1176 (setq | 1098 (push (cons key-attribs midname) sc-attributions) |
1177 sc-attributions (cons (cons key-attribs midname) | 1099 (push (cons key-mail midname) sc-mail-info) |
1178 sc-attributions) | 1100 (setq n (1+ n)) |
1179 sc-mail-info (cons (cons key-mail midname) | |
1180 sc-mail-info) | |
1181 n (1+ n)) | |
1182 midname))) | 1101 midname))) |
1183 midnames " ") | 1102 midnames " ") |
1184 | 1103 |
1185 author (concat firstname " " middlenames (and midnames " ") lastname) | 1104 author (concat firstname " " middlenames (and midnames " ") lastname) |
1186 | 1105 |
1210 namestring)) | 1129 namestring)) |
1211 ) | 1130 ) |
1212 sc-mail-info) | 1131 sc-mail-info) |
1213 )) | 1132 )) |
1214 ;; from string is empty | 1133 ;; from string is empty |
1215 (setq sc-mail-info (cons (cons "sc-author" sc-default-author-name) | 1134 (push (cons "sc-author" sc-default-author-name) sc-mail-info))) |
1216 sc-mail-info)))) | |
1217 | 1135 |
1218 (defvar sc-attrib-or-cite nil | 1136 (defvar sc-attrib-or-cite nil |
1219 "Used to toggle between attribution input or citation input.") | 1137 "Used to toggle between attribution input or citation input.") |
1220 | 1138 |
1221 (defun sc-toggle-fn () | 1139 (defun sc-toggle-fn () |
1264 (setq attriblist (cdr attriblist))) | 1182 (setq attriblist (cdr attriblist))) |
1265 ((stringp attrib) | 1183 ((stringp attrib) |
1266 (setq attribution attrib | 1184 (setq attribution attrib |
1267 attriblist nil)) | 1185 attriblist nil)) |
1268 ((listp attrib) | 1186 ((listp attrib) |
1269 (setq attribution (eval attrib) | 1187 (setq attribution (eval attrib)) |
1270 attriblist nil)) | 1188 (if (stringp attribution) |
1189 (setq attriblist nil) | |
1190 (setq attribution nil | |
1191 attriblist (cdr attriblist)))) | |
1271 (t (error "%s did not evaluate to a string or list!" | 1192 (t (error "%s did not evaluate to a string or list!" |
1272 "sc-attrib-selection-list")) | 1193 "sc-attrib-selection-list")) |
1273 ))) | 1194 ))) |
1274 ((setq attribution (cdr (assoc preferred sc-attributions))) | 1195 ((setq attribution (cdr (assoc preferred sc-attributions))) |
1275 (setq attriblist nil)) | 1196 (setq attriblist nil)) |
1323 (while | 1244 (while |
1324 (catch 'sc-reconfirm | 1245 (catch 'sc-reconfirm |
1325 (progn | 1246 (progn |
1326 (setq choice | 1247 (setq choice |
1327 (if sc-attrib-or-cite | 1248 (if sc-attrib-or-cite |
1328 (sc-read-string | 1249 (read-string |
1329 "Enter citation prefix: " | 1250 "Enter citation prefix: " |
1330 citation | 1251 citation |
1331 'sc-citation-confirmation-history) | 1252 'sc-citation-confirmation-history) |
1332 (sc-completing-read | 1253 (completing-read |
1333 "Complete attribution name: " | 1254 "Complete attribution name: " |
1334 query-alist nil nil | 1255 query-alist nil nil |
1335 (cons initial 0) | 1256 (cons initial 0) |
1336 'sc-attribution-confirmation-history) | 1257 'sc-attribution-confirmation-history) |
1337 )) | 1258 )) |
1358 (akey "sc-attribution") | 1279 (akey "sc-attribution") |
1359 (ckeyval (assoc ckey sc-mail-info)) | 1280 (ckeyval (assoc ckey sc-mail-info)) |
1360 (akeyval (assoc akey sc-mail-info))) | 1281 (akeyval (assoc akey sc-mail-info))) |
1361 (if ckeyval | 1282 (if ckeyval |
1362 (setcdr ckeyval citation) | 1283 (setcdr ckeyval citation) |
1363 (setq sc-mail-info | 1284 (push (cons ckey citation) sc-mail-info)) |
1364 (append (list (cons ckey citation)) sc-mail-info))) | |
1365 (if akeyval | 1285 (if akeyval |
1366 (setcdr akeyval attribution) | 1286 (setcdr akeyval attribution) |
1367 (setq sc-mail-info | 1287 (push (cons akey attribution) sc-mail-info))) |
1368 (append (list (cons akey attribution)) sc-mail-info)))) | |
1369 | 1288 |
1370 ;; set the sc-lastchoice attribution | 1289 ;; set the sc-lastchoice attribution |
1371 (let* ((lkey "sc-lastchoice") | 1290 (let* ((lkey "sc-lastchoice") |
1372 (lastchoice (assoc lkey sc-attributions))) | 1291 (lastchoice (assoc lkey sc-attributions))) |
1373 (if lastchoice | 1292 (if lastchoice |
1374 (setcdr lastchoice attribution) | 1293 (setcdr lastchoice attribution) |
1375 (setq sc-attributions | 1294 (push (cons lkey attribution) sc-attributions))) |
1376 (cons (cons lkey attribution) sc-attributions)))) | |
1377 )) | 1295 )) |
1378 | 1296 |
1379 | 1297 |
1380 ;; ====================================================================== | 1298 ;; ====================================================================== |
1381 ;; filladapt hooks for supercite 3.1. you shouldn't need anything | 1299 ;; filladapt hooks for supercite 3.1. you shouldn't need anything |
1398 (concat sc-citation-leader | 1316 (concat sc-citation-leader |
1399 attribution | 1317 attribution |
1400 sc-citation-delimiter | 1318 sc-citation-delimiter |
1401 sc-citation-separator)) | 1319 sc-citation-separator)) |
1402 | 1320 |
1321 (defvar filladapt-prefix-table) | |
1322 | |
1403 (defun sc-setup-filladapt () | 1323 (defun sc-setup-filladapt () |
1404 "Setup `filladapt-prefix-table' to handle Supercited paragraphs." | 1324 "Setup `filladapt-prefix-table' to handle Supercited paragraphs." |
1405 (let* ((fa-sc-elt 'filladapt-supercite-included-text) | 1325 (let* ((fa-sc-elt 'filladapt-supercite-included-text) |
1406 (elt (rassq fa-sc-elt filladapt-prefix-table))) | 1326 (elt (rassq fa-sc-elt filladapt-prefix-table))) |
1407 (if elt (setcar elt (sc-cite-regexp)) | 1327 (if elt (setcar elt (sc-cite-regexp)) |
1424 If `sc-auto-fill-region-p' is nil, do not fill region. If PREFIX is | 1344 If `sc-auto-fill-region-p' is nil, do not fill region. If PREFIX is |
1425 not supplied, initialize fill variables. This is useful for a regi | 1345 not supplied, initialize fill variables. This is useful for a regi |
1426 `begin' frame-entry." | 1346 `begin' frame-entry." |
1427 (if (not prefix) | 1347 (if (not prefix) |
1428 (setq sc-fill-line-prefix "" | 1348 (setq sc-fill-line-prefix "" |
1429 sc-fill-begin (regi-pos 'bol)) | 1349 sc-fill-begin (line-beginning-position)) |
1430 (if (and sc-auto-fill-region-p | 1350 (if (and sc-auto-fill-region-p |
1431 (not (string= prefix sc-fill-line-prefix))) | 1351 (not (string= prefix sc-fill-line-prefix))) |
1432 (let ((fill-prefix sc-fill-line-prefix)) | 1352 (let ((fill-prefix sc-fill-line-prefix)) |
1433 (if (not (string= fill-prefix "")) | 1353 (if (not (string= fill-prefix "")) |
1434 (fill-region sc-fill-begin (regi-pos 'bol))) | 1354 (fill-region sc-fill-begin (line-beginning-position))) |
1435 (setq sc-fill-line-prefix prefix | 1355 (setq sc-fill-line-prefix prefix |
1436 sc-fill-begin (regi-pos 'bol)))) | 1356 sc-fill-begin (line-beginning-position)))) |
1437 ) | 1357 ) |
1438 nil) | 1358 nil) |
1439 | 1359 |
1440 (defun sc-cite-coerce-cited-line () | 1360 (defun sc-cite-coerce-cited-line () |
1441 "Coerce a Supercited line to look like our style." | 1361 "Coerce a Supercited line to look like our style." |
1465 "Guess the citation nesting on the current line. | 1385 "Guess the citation nesting on the current line. |
1466 If nesting cannot be guessed, nil is returned. Optional STRING if | 1386 If nesting cannot be guessed, nil is returned. Optional STRING if |
1467 supplied, is used instead of the line point is on in the current | 1387 supplied, is used instead of the line point is on in the current |
1468 buffer." | 1388 buffer." |
1469 (let ((start 0) | 1389 (let ((start 0) |
1470 (string (or string (buffer-substring (regi-pos 'bol) (regi-pos 'eol)))) | 1390 (string (or string (buffer-substring (line-beginning-position) |
1391 (line-end-position)))) | |
1471 nesting) | 1392 nesting) |
1472 (and | 1393 (and |
1473 (= start (or (string-match sc-citation-leader-regexp string start) -1)) | 1394 (= start (or (string-match sc-citation-leader-regexp string start) -1)) |
1474 (setq start (match-end 0)) | 1395 (setq start (match-end 0)) |
1475 (= start (or (string-match sc-citation-delimiter-regexp string start) -1)) | 1396 (= start (or (string-match sc-citation-delimiter-regexp string start) -1)) |
1476 (setq nesting (sc-submatch 0 string) | 1397 (setq nesting (match-string 0 string) |
1477 start (match-end 0)) | 1398 start (match-end 0)) |
1478 (= start (or (string-match sc-citation-separator-regexp string start) -1)) | 1399 (= start (or (string-match sc-citation-separator-regexp string start) -1)) |
1479 nesting))) | 1400 nesting))) |
1480 | 1401 |
1481 (defun sc-add-citation-level () | 1402 (defun sc-add-citation-level () |
1517 (insert (or prefix sc-default-attribution)) | 1438 (insert (or prefix sc-default-attribution)) |
1518 (sc-fill-if-different prefix)) | 1439 (sc-fill-if-different prefix)) |
1519 nil) | 1440 nil) |
1520 | 1441 |
1521 ;; interactive functions | 1442 ;; interactive functions |
1522 (defun sc-cite-region (start end &optional confirm-p) | 1443 (defun sc-cite-region (start end &optional confirm-p interactive) |
1523 "Cite a region delineated by START and END. | 1444 "Cite a region delineated by START and END. |
1524 If optional CONFIRM-P is non-nil, the attribution is confirmed before | 1445 If optional CONFIRM-P is non-nil, the attribution is confirmed before |
1525 its use in the citation string. This function first runs | 1446 its use in the citation string. This function first runs |
1526 `sc-pre-cite-hook'." | 1447 `sc-pre-cite-hook'. |
1527 (interactive "r\nP") | 1448 |
1449 When called interactively, the optional arg INTERACTIVE is non-nil, | |
1450 and that means call `sc-select-attribution' too." | |
1451 (interactive "r\nP\np") | |
1528 (undo-boundary) | 1452 (undo-boundary) |
1529 (let ((frame (or (sc-scan-info-alist sc-cite-frame-alist) | 1453 (let ((frame (sc-scan-info-alist sc-cite-frame-alist)) |
1530 sc-default-cite-frame)) | |
1531 (sc-confirm-always-p (if confirm-p t sc-confirm-always-p))) | 1454 (sc-confirm-always-p (if confirm-p t sc-confirm-always-p))) |
1455 (if (and frame (symbolp frame)) | |
1456 (setq frame (symbol-value frame))) | |
1457 (or frame (setq frame sc-default-cite-frame)) | |
1532 (run-hooks 'sc-pre-cite-hook) | 1458 (run-hooks 'sc-pre-cite-hook) |
1533 (if (interactive-p) | 1459 (if interactive |
1534 (sc-select-attribution)) | 1460 (sc-select-attribution)) |
1535 (regi-interpret frame start end))) | 1461 (regi-interpret frame start end))) |
1536 | 1462 |
1537 (defun sc-uncite-region (start end) | 1463 (defun sc-uncite-region (start end) |
1538 "Uncite a region delineated by START and END. | 1464 "Uncite a region delineated by START and END. |
1539 First runs `sc-pre-uncite-hook'." | 1465 First runs `sc-pre-uncite-hook'." |
1540 (interactive "r") | 1466 (interactive "r") |
1541 (undo-boundary) | 1467 (undo-boundary) |
1542 (let ((frame (or (sc-scan-info-alist sc-uncite-frame-alist) | 1468 (let ((frame (sc-scan-info-alist sc-uncite-frame-alist))) |
1543 sc-default-uncite-frame))) | 1469 (if (and frame (symbolp frame)) |
1470 (setq frame (symbol-value frame))) | |
1471 (or frame (setq frame sc-default-uncite-frame)) | |
1544 (run-hooks 'sc-pre-uncite-hook) | 1472 (run-hooks 'sc-pre-uncite-hook) |
1545 (regi-interpret frame start end))) | 1473 (regi-interpret frame start end))) |
1546 | 1474 |
1547 (defun sc-recite-region (start end) | 1475 (defun sc-recite-region (start end) |
1548 "Recite a region delineated by START and END. | 1476 "Recite a region delineated by START and END. |
1549 First runs `sc-pre-recite-hook'." | 1477 First runs `sc-pre-recite-hook'." |
1550 (interactive "r") | 1478 (interactive "r") |
1551 (let ((sc-confirm-always-p t)) | 1479 (let ((sc-confirm-always-p t)) |
1552 (sc-select-attribution)) | 1480 (sc-select-attribution)) |
1553 (undo-boundary) | 1481 (undo-boundary) |
1554 (let ((frame (or (sc-scan-info-alist sc-recite-frame-alist) | 1482 (let ((frame (sc-scan-info-alist sc-recite-frame-alist))) |
1555 sc-default-recite-frame))) | 1483 (if (and frame (symbolp frame)) |
1484 (setq frame (symbol-value frame))) | |
1485 (or frame (setq frame sc-default-recite-frame)) | |
1556 (run-hooks 'sc-pre-recite-hook) | 1486 (run-hooks 'sc-pre-recite-hook) |
1557 (regi-interpret frame start end))) | 1487 (regi-interpret frame start end))) |
1558 | 1488 |
1559 | 1489 |
1560 ;; ====================================================================== | 1490 ;; ====================================================================== |
1585 (if (not (bobp)) | 1515 (if (not (bobp)) |
1586 (if (and (eolp) | 1516 (if (and (eolp) |
1587 (progn (forward-line -1) | 1517 (progn (forward-line -1) |
1588 (or (= (point) (mail-header-end)) | 1518 (or (= (point) (mail-header-end)) |
1589 (and (eq major-mode 'mh-letter-mode) | 1519 (and (eq major-mode 'mh-letter-mode) |
1590 (mh-in-header-p))))) | 1520 (with-no-warnings |
1521 (mh-in-header-p)))))) | |
1591 (progn (forward-line) | 1522 (progn (forward-line) |
1592 (let ((kill-lines-magic t)) | 1523 (let ((kill-lines-magic t)) |
1593 (kill-line)))))) | 1524 (kill-line)))))) |
1594 | 1525 |
1595 (defun sc-header-on-said () | 1526 (defun sc-header-on-said () |
1742 (buffer-read-only t) | 1673 (buffer-read-only t) |
1743 (mode-name "SC Electric Refs") | 1674 (mode-name "SC Electric Refs") |
1744 (major-mode 'sc-electric-mode)) | 1675 (major-mode 'sc-electric-mode)) |
1745 (use-local-map sc-electric-mode-map) | 1676 (use-local-map sc-electric-mode-map) |
1746 (sc-eref-show sc-eref-style) | 1677 (sc-eref-show sc-eref-style) |
1747 (run-hooks 'sc-electric-mode-hook) | 1678 (run-mode-hooks 'sc-electric-mode-hook) |
1748 (recursive-edit) | 1679 (recursive-edit) |
1749 ))) | 1680 ))) |
1750 | 1681 |
1751 (and sc-eref-style | 1682 (and sc-eref-style |
1752 (sc-eref-insert-selected)) | 1683 (sc-eref-insert-selected)) |
1861 "Toggle, in one fell swoop, two important SC variables: | 1792 "Toggle, in one fell swoop, two important SC variables: |
1862 `sc-fixup-whitespace-p' and `sc-auto-fill-region-p'" | 1793 `sc-fixup-whitespace-p' and `sc-auto-fill-region-p'" |
1863 (interactive) | 1794 (interactive) |
1864 (setq sc-fixup-whitespace-p (not sc-fixup-whitespace-p) | 1795 (setq sc-fixup-whitespace-p (not sc-fixup-whitespace-p) |
1865 sc-auto-fill-region-p (not sc-auto-fill-region-p)) | 1796 sc-auto-fill-region-p (not sc-auto-fill-region-p)) |
1866 (sc-set-mode-string) | |
1867 (force-mode-line-update)) | 1797 (force-mode-line-update)) |
1868 | 1798 |
1869 (defun sc-toggle-var (variable) | 1799 (defun sc-toggle-var (variable) |
1870 "Boolean toggle VARIABLE's value. | 1800 "Boolean toggle VARIABLE's value. |
1871 VARIABLE must be a bound symbol. nil values change to t, non-nil | 1801 VARIABLE must be a bound symbol. nil values change to t, non-nil |
1872 values are changed to nil." | 1802 values are changed to nil." |
1873 (message "%s changed from %s to %s" | 1803 (message "%s changed from %s to %s" |
1874 variable (symbol-value variable) | 1804 variable (symbol-value variable) |
1875 (set variable (not (symbol-value variable)))) | 1805 (set variable (not (symbol-value variable))))) |
1876 (sc-set-mode-string)) | |
1877 | 1806 |
1878 (defun sc-set-variable (var) | 1807 (defun sc-set-variable (var) |
1879 "Set the Supercite VARIABLE. | 1808 "Set the Supercite VARIABLE. |
1880 This function mimics `set-variable', except that the variable to set | 1809 This function mimics `set-variable', except that the variable to set |
1881 is determined non-interactively. The value is queried for in the | 1810 is determined non-interactively. The value is queried for in the |
1884 You can see the current value of the variable when the minibuffer is | 1813 You can see the current value of the variable when the minibuffer is |
1885 querying you by typing `C-h'. Note that the format is changed | 1814 querying you by typing `C-h'. Note that the format is changed |
1886 slightly from that used by `set-variable' -- the current value is | 1815 slightly from that used by `set-variable' -- the current value is |
1887 printed just after the variable's name instead of at the bottom of the | 1816 printed just after the variable's name instead of at the bottom of the |
1888 help window." | 1817 help window." |
1889 (let* ((minibuffer-help-form | 1818 (let* ((minibuffer-help-form '(funcall myhelp)) |
1890 '(funcall myhelp)) | |
1891 (myhelp | 1819 (myhelp |
1892 (function | 1820 (lambda () |
1893 (lambda () | 1821 (with-output-to-temp-buffer "*Help*" |
1894 (with-output-to-temp-buffer "*Help*" | 1822 (prin1 var) |
1895 (prin1 var) | 1823 (if (boundp var) |
1896 (if (boundp var) | 1824 (let ((print-length 20)) |
1897 (let ((print-length 20)) | 1825 (princ "\t(Current value: ") |
1898 (princ "\t(Current value: ") | 1826 (prin1 (symbol-value var)) |
1899 (prin1 (symbol-value var)) | 1827 (princ ")"))) |
1900 (princ ")"))) | 1828 (princ "\n\nDocumentation:\n") |
1901 (princ "\n\nDocumentation:\n") | 1829 (princ (substring (documentation-property |
1902 (princ (substring (documentation-property | 1830 var |
1903 var | 1831 'variable-documentation) |
1904 'variable-documentation) | 1832 1)) |
1905 1)) | 1833 (with-current-buffer standard-output |
1906 (save-excursion | 1834 (help-mode)) |
1907 (set-buffer standard-output) | 1835 nil)))) |
1908 (help-mode)) | 1836 (set var (eval-minibuffer (format "Set %s to value: " var))))) |
1909 nil))))) | |
1910 (set var (eval-minibuffer (format "Set %s to value: " var)))) | |
1911 (sc-set-mode-string)) | |
1912 | 1837 |
1913 (defmacro sc-toggle-symbol (rootname) | 1838 (defmacro sc-toggle-symbol (rootname) |
1914 (list 'defun (intern (concat "sc-T-" rootname)) '() | 1839 `(defun ,(intern (concat "sc-T-" rootname)) () |
1915 (list 'interactive) | 1840 (interactive) |
1916 (list 'sc-toggle-var | 1841 (sc-toggle-var ',(intern (concat "sc-" rootname "-p"))))) |
1917 (list 'quote (intern (concat "sc-" rootname "-p")))))) | |
1918 | 1842 |
1919 (defmacro sc-setvar-symbol (rootname) | 1843 (defmacro sc-setvar-symbol (rootname) |
1920 (list 'defun (intern (concat "sc-S-" rootname)) '() | 1844 `(defun ,(intern (concat "sc-S-" rootname)) () |
1921 (list 'interactive) | 1845 (interactive) |
1922 (list 'sc-set-variable | 1846 (sc-set-variable ',(intern (concat "sc-" rootname))))) |
1923 (list 'quote (intern (concat "sc-" rootname)))))) | |
1924 | 1847 |
1925 (sc-toggle-symbol "confirm-always") | 1848 (sc-toggle-symbol "confirm-always") |
1926 (sc-toggle-symbol "downcase") | 1849 (sc-toggle-symbol "downcase") |
1927 (sc-toggle-symbol "electric-references") | 1850 (sc-toggle-symbol "electric-references") |
1928 (sc-toggle-symbol "auto-fill-region") | 1851 (sc-toggle-symbol "auto-fill-region") |
1951 | 1874 |
1952 \\{sc-T-keymap}" | 1875 \\{sc-T-keymap}" |
1953 (interactive) | 1876 (interactive) |
1954 (describe-function 'sc-T-describe)) | 1877 (describe-function 'sc-T-describe)) |
1955 | 1878 |
1956 (defun sc-set-mode-string () | |
1957 "Update the minor mode string to show state of Supercite." | |
1958 (setq sc-mode-string | |
1959 (concat " SC" | |
1960 (if (or sc-auto-fill-region-p | |
1961 sc-fixup-whitespace-p) | |
1962 ":" "") | |
1963 (if sc-auto-fill-region-p "f" "") | |
1964 (if sc-fixup-whitespace-p "w" "") | |
1965 ))) | |
1966 | |
1967 | 1879 |
1968 ;; ====================================================================== | 1880 ;; ====================================================================== |
1969 ;; published interface to mail and news readers | 1881 ;; published interface to mail and news readers |
1882 | |
1883 (define-minor-mode sc-minor-mode | |
1884 "Supercite minor mode." | |
1885 :group 'supercite | |
1886 :lighter (" SC" (sc-auto-fill-region-p | |
1887 (":f" (sc-fixup-whitespace-p "w")) | |
1888 (sc-fixup-whitespace-p ":w"))) | |
1889 :keymap `((,sc-mode-map-prefix . ,sc-mode-map))) | |
1970 | 1890 |
1971 ;;;###autoload | 1891 ;;;###autoload |
1972 (defun sc-cite-original () | 1892 (defun sc-cite-original () |
1973 "Workhorse citing function which performs the initial citation. | 1893 "Workhorse citing function which performs the initial citation. |
1974 This is callable from the various mail and news readers' reply | 1894 This is callable from the various mail and news readers' reply |
1975 function according to the agreed upon standard. See `\\[sc-describe]' | 1895 function according to the agreed upon standard. See the associated |
1976 for more details. `sc-cite-original' does not do any yanking of the | 1896 info node `(SC)Top' for more details. |
1897 `sc-cite-original' does not do any yanking of the | |
1977 original message but it does require a few things: | 1898 original message but it does require a few things: |
1978 | 1899 |
1979 1) The reply buffer is the current buffer. | 1900 1) The reply buffer is the current buffer. |
1980 | 1901 |
1981 2) The original message has been yanked and inserted into the | 1902 2) The original message has been yanked and inserted into the |
1992 For Emacs 19's, the region need not be active (and typically isn't | 1913 For Emacs 19's, the region need not be active (and typically isn't |
1993 when this function is called. Also, the hook `sc-pre-hook' is run | 1914 when this function is called. Also, the hook `sc-pre-hook' is run |
1994 before, and `sc-post-hook' is run after the guts of this function." | 1915 before, and `sc-post-hook' is run after the guts of this function." |
1995 (run-hooks 'sc-pre-hook) | 1916 (run-hooks 'sc-pre-hook) |
1996 | 1917 |
1997 ;; before we do anything, we want to insert the supercite keymap so | 1918 (sc-minor-mode 1) |
1998 ;; we can proceed from here | |
1999 (and sc-mode-map-prefix | |
2000 (local-set-key sc-mode-map-prefix sc-mode-map)) | |
2001 | |
2002 ;; hack onto the minor mode alist, if it hasn't been done before, | |
2003 ;; then turn on the minor mode. also, set the minor mode string with | |
2004 ;; the values of fill and fixup whitespace variables | |
2005 (if (not (get 'minor-mode-alist 'sc-minor-mode)) | |
2006 (progn | |
2007 (put 'minor-mode-alist 'sc-minor-mode 'sc-minor-mode) | |
2008 (setq minor-mode-alist | |
2009 (cons '(sc-minor-mode sc-mode-string) minor-mode-alist)) | |
2010 )) | |
2011 (setq sc-minor-mode t) | |
2012 (sc-set-mode-string) | |
2013 | 1919 |
2014 (undo-boundary) | 1920 (undo-boundary) |
2015 | 1921 |
2016 ;; grab point and mark since the region is probably not active when | 1922 ;; grab point and mark since the region is probably not active when |
2017 ;; this function gets automatically called. we want point to be a | 1923 ;; this function gets automatically called. we want point to be a |
2018 ;; mark so any deleting before point works properly | 1924 ;; mark so any deleting before point works properly |
2019 (let* ((zmacs-regions nil) ; for Lemacs | 1925 (let* ((zmacs-regions nil) ; for XEemacs |
2020 (mark-active t) ; for Emacs | 1926 (mark-active t) ; for Emacs |
2021 (point (point-marker)) | 1927 (point (point-marker)) |
2022 (mark (copy-marker (mark-marker)))) | 1928 (mark (copy-marker (mark-marker)))) |
2023 | 1929 |
2024 ;; make sure point comes before mark, not all functions are | 1930 ;; make sure point comes before mark, not all functions are |
2059 | 1965 |
2060 ;; finally, free the point-marker | 1966 ;; finally, free the point-marker |
2061 (set-marker point nil) | 1967 (set-marker point nil) |
2062 (set-marker mark nil) | 1968 (set-marker mark nil) |
2063 ) | 1969 ) |
2064 (run-hooks 'sc-post-hook) | 1970 (run-hooks 'sc-post-hook)) |
2065 ;; post hook could have changed the variables | |
2066 (sc-set-mode-string)) | |
2067 | 1971 |
2068 | 1972 |
2069 ;; ====================================================================== | 1973 ;; ====================================================================== |
2070 ;; bug reporting and miscellaneous commands | 1974 ;; bug reporting and miscellaneous commands |
2071 | 1975 |
2075 (interactive "p") | 1979 (interactive "p") |
2076 (save-excursion | 1980 (save-excursion |
2077 (let ((start (point)) | 1981 (let ((start (point)) |
2078 (prefix (or (progn (beginning-of-line) | 1982 (prefix (or (progn (beginning-of-line) |
2079 (if (looking-at (sc-cite-regexp)) | 1983 (if (looking-at (sc-cite-regexp)) |
2080 (sc-submatch 0))) | 1984 (match-string 0))) |
2081 ""))) | 1985 ""))) |
2082 (goto-char start) | 1986 (goto-char start) |
2083 (open-line arg) | 1987 (open-line arg) |
2084 (forward-line 1) | 1988 (forward-line 1) |
2085 (while (< 0 arg) | 1989 (while (< 0 arg) |
2099 (looking-at "^[ \t]*$") | 2003 (looking-at "^[ \t]*$") |
2100 (consp arg)) | 2004 (consp arg)) |
2101 (insert (sc-mail-field "sc-citation")) | 2005 (insert (sc-mail-field "sc-citation")) |
2102 (error "Line is already cited")))) | 2006 (error "Line is already cited")))) |
2103 | 2007 |
2104 (defun sc-version (arg) | 2008 (defun sc-version (message) |
2105 "Echo the current version of Supercite in the minibuffer. | 2009 "Echo the current version of Supercite in the minibuffer. |
2106 With \\[universal-argument] (universal-argument), or if run non-interactively, | 2010 If MESSAGE is non-nil (interactively, with no prefix argument), |
2107 inserts the version string in the current buffer instead." | 2011 inserts the version string in the current buffer instead." |
2108 (interactive "P") | 2012 (interactive (not current-prefix-arg)) |
2109 (let ((verstr (format "Using Supercite.el %s" sc-version))) | 2013 (let ((verstr (format "Using Supercite.el %s" sc-version))) |
2110 (if (or (consp arg) | 2014 (if message |
2111 (not (interactive-p))) | 2015 (message verstr) |
2112 (insert "`sc-version' says: " verstr) | 2016 (insert "`sc-version' says: " verstr)))) |
2113 (message verstr)))) | |
2114 | 2017 |
2115 (defun sc-describe () | 2018 (defun sc-describe () |
2116 " | 2019 " |
2117 Supercite is a package which provides a flexible mechanism for citing | 2020 Supercite is a package which provides a flexible mechanism for citing |
2118 email and news replies. Please see the associated texinfo file for | 2021 email and news replies. Please see the associated texinfo file for |
2119 more information." | 2022 more information. Info node `(SC)Top'." |
2120 (interactive) | 2023 (interactive) |
2121 (describe-function 'sc-describe)) | 2024 (describe-function 'sc-describe)) |
2122 | 2025 |
2123 (defun sc-submit-bug-report () | 2026 (defun sc-submit-bug-report () |
2124 "Submit a bug report on Supercite via mail." | 2027 "Submit a bug report on Supercite via mail." |
2166 | 2069 |
2167 ;; useful stuff | 2070 ;; useful stuff |
2168 (provide 'supercite) | 2071 (provide 'supercite) |
2169 (run-hooks 'sc-load-hook) | 2072 (run-hooks 'sc-load-hook) |
2170 | 2073 |
2074 ;; arch-tag: a5d5bfa6-3bd5-4414-8c65-0afc83e45cd3 | |
2171 ;;; supercite.el ends here | 2075 ;;; supercite.el ends here |