[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] Changes to emacs/lisp/mail/supercite.el [lexbind]
|
From: |
Miles Bader |
|
Subject: |
[Emacs-diffs] Changes to emacs/lisp/mail/supercite.el [lexbind] |
|
Date: |
Tue, 14 Oct 2003 19:39:44 -0400 |
Index: emacs/lisp/mail/supercite.el
diff -c emacs/lisp/mail/supercite.el:1.30.2.1
emacs/lisp/mail/supercite.el:1.30.2.2
*** emacs/lisp/mail/supercite.el:1.30.2.1 Fri Apr 4 01:20:27 2003
--- emacs/lisp/mail/supercite.el Tue Oct 14 19:39:25 2003
***************
*** 1,9 ****
;;; supercite.el --- minor mode for citing mail and news replies
! ;; Copyright (C) 1993, 1997 Free Software Foundation, Inc.
;; Author: 1993 Barry A. Warsaw, Century Computing, Inc. <address@hidden>
! ;; Maintainer: Mark Senn <address@hidden>
;; Created: February 1993
;; Last Modified: 1993/09/22 18:58:46
;; Keywords: mail, news
--- 1,9 ----
;;; supercite.el --- minor mode for citing mail and news replies
! ;; Copyright (C) 1993, 1997, 2003 Free Software Foundation, Inc.
;; Author: 1993 Barry A. Warsaw, Century Computing, Inc. <address@hidden>
! ;; Maintainer: FSF
;; Created: February 1993
;; Last Modified: 1993/09/22 18:58:46
;; Keywords: mail, news
***************
*** 510,548 ****
(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.")
(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)
;; ======================================================================
--- 510,524 ----
(defvar sc-attributions nil
"Alist of attributions for use when citing.")
(defvar sc-tmp-nested-regexp nil
! "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.")
(make-variable-buffer-local 'sc-mail-info)
(make-variable-buffer-local 'sc-attributions)
;; ======================================================================
***************
*** 552,691 ****
"*Key binding to install Supercite keymap.
If this is nil, Supercite keymap is not installed.")
! (defvar sc-T-keymap ()
"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 ()
"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 ()
"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
"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
"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
--- 528,609 ----
"*Key binding to install Supercite keymap.
If this is nil, Supercite keymap is not installed.")
! (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.")
! (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.")
! (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.")
!
! (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.")
! (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.")
;; ======================================================================
;; utility functions
(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,733 ****
") "))
(p prompt)
(event
! (if (memq 'Lucid sc-emacs-features)
(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))))
(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))
(setq quit-flag nil)
(signal 'quit '())))
(let ((char
! (if (memq 'Lucid sc-emacs-features)
(let* ((key (and (key-press-event-p event) (event-key event)))
(char (and key (event-to-character event))))
char)
--- 622,644 ----
") "))
(p prompt)
(event
! (if (fboundp 'allocate-event)
(allocate-event)
nil)))
(while (stringp p)
(if (let ((cursor-in-echo-area t)
(inhibit-quit t))
(message "%s" p)
! (setq event (read-event))
(prog1 quit-flag (setq quit-flag nil)))
(progn
(message "%s%s" p (single-key-description event))
! (and (fboundp 'deallocate-event)
(deallocate-event event))
(setq quit-flag nil)
(signal 'quit '())))
(let ((char
! (if (featurep 'xemacs)
(let* ((key (and (key-press-event-p event) (event-key event)))
(char (and key (event-to-character event))))
char)
***************
*** 738,755 ****
((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
nil)
(t
(message "%s%s" p (single-key-description event))
! (if (memq 'Lucid sc-emacs-features)
(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))
p))
--- 649,666 ----
((setq elt (rassq char alist))
(message "%s%s" p (car elt))
(setq p (cdr elt)))
! ((and (fboundp 'button-release-event-p)
(button-release-event-p event)) ; ignore them
nil)
(t
(message "%s%s" p (single-key-description event))
! (if (featurep 'xemacs)
(ding nil 'y-or-n-p)
(ding))
(discard-input)
(if (eq p prompt)
(setq p (concat "Try again. " prompt)))))))
! (and (fboundp 'deallocate-event)
(deallocate-event event))
p))
***************
*** 801,807 ****
(end (setq sc-mail-headers-end (point))))
"Regi frame for glomming mail header information.")
! (eval-when-compile (defvar curline)) ; dynamic bondage
;; regi functions
(defun sc-mail-fetch-field (&optional attribs-p)
--- 712,718 ----
(end (setq sc-mail-headers-end (point))))
"Regi frame for glomming mail header information.")
! (defvar curline) ; dynamic bondage
;; regi functions
(defun sc-mail-fetch-field (&optional attribs-p)
***************
*** 809,821 ****
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)))
(keyval (cons key val)))
! (setq sc-mail-info (cons keyval sc-mail-info))
(if attribs-p
! (setq sc-attributions (cons keyval sc-attributions)))
! ))
nil)
(defun sc-mail-append-field ()
--- 720,731 ----
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 (match-string-no-properties 1 curline)))
! (val (match-string-no-properties 2 curline))
(keyval (cons key val)))
! (push keyval sc-mail-info)
(if attribs-p
! (push keyval sc-attributions))))
nil)
(defun sc-mail-append-field ()
***************
*** 823,829 ****
(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))))))
nil)
(defun sc-mail-error-in-mail-field ()
--- 733,739 ----
(let ((keyval (car sc-mail-info)))
(if (and keyval (string-match "^\\s *\\(.*\\)$" curline))
(setcdr keyval (concat (cdr keyval) " "
! (match-string-no-properties 1 curline)))))
nil)
(defun sc-mail-error-in-mail-field ()
***************
*** 842,848 ****
(defun sc-mail-nuke-line ()
"Nuke the current mail header line."
! (delete-region (regi-pos 'bol) (regi-pos 'bonl))
'((step . -1)))
(defun sc-mail-nuke-header-line ()
--- 752,758 ----
(defun sc-mail-nuke-line ()
"Nuke the current mail header line."
! (delete-region (line-beginning-position) (line-beginning-position 2))
'((step . -1)))
(defun sc-mail-nuke-header-line ()
***************
*** 866,872 ****
(delete-blank-lines)
(beginning-of-line)
(if (looking-at "[ \t]*$")
! (delete-region (regi-pos 'bol) (regi-pos 'bonl)))
(insert-char ?\n sc-blank-lines-after-headers)))
nil)
--- 776,783 ----
(delete-blank-lines)
(beginning-of-line)
(if (looking-at "[ \t]*$")
! (delete-region (line-beginning-position)
! (line-beginning-position 2)))
(insert-char ?\n sc-blank-lines-after-headers)))
nil)
***************
*** 938,944 ****
key)
(if (not action)
()
! (setq key (sc-completing-read
(concat (car (rassq action alist))
" information key: ")
sc-mail-info nil
--- 849,855 ----
key)
(if (not action)
()
! (setq key (completing-read
(concat (car (rassq action alist))
" information key: ")
sc-mail-info nil
***************
*** 952,968 ****
((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))
(setq sc-mail-field-modification-history
(cons (cdr keyval) sc-mail-field-modification-history)))
! (setcdr keyval (sc-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)))
))))
--- 863,877 ----
((eq action ?m)
(let ((keyval (assoc key sc-mail-info)))
;; first put initial value onto list if not already there
! (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 (read-string
(concat key ": ") (cdr keyval)
'sc-mail-field-modification-history))))
((eq action ?a)
! (push (cons key (read-string (concat key ": "))) sc-mail-info))
))))
***************
*** 980,986 ****
of \"%\" and addresses of the style address@hidden'' 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)
(substring from
(match-beginning 0)
(- (match-end 0) (if (null delim) 0 1)))))
--- 889,895 ----
of \"%\" and addresses of the style address@hidden'' when
called with DELIM \"@\". If DELIM is nil or not provided, matches
addresses of the style ``name''."
! (and (string-match (concat "[-[:alnum:]_.]+" delim) from 0)
(substring from
(match-beginning 0)
(- (match-end 0) (if (null delim) 0 1)))))
***************
*** 989,995 ****
"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_.]\\|$\\)"
from 0))
(mend (match-end 0)))
(and mstart
--- 898,904 ----
"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 "![-[:alnum:]_.]+\\([^-![:alnum:]_.]\\|$\\)"
from 0))
(mend (match-end 0)))
(and mstart
***************
*** 1000,1006 ****
"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)))
(defun sc-get-address (from author)
"Get the full email address path from FROM.
--- 909,915 ----
"Extract the author's email terminus from email address FROM.
Match addresses of the style ``<name[stuff]>.''"
(and (string-match "<\\(.*\\)>" from)
! (match-string 1 from)))
(defun sc-get-address (from author)
"Get the full email address path from FROM.
***************
*** 1014,1020 ****
(substring address 1 (1- (length address)))
address))
(if (string-match "[-[:alnum:address@hidden" from 0)
! (sc-submatch 0 from)
"")
)))
--- 923,929 ----
(substring address 1 (1- (length address)))
address))
(if (string-match "[-[:alnum:address@hidden" from 0)
! (match-string 0 from)
"")
)))
***************
*** 1042,1047 ****
--- 951,957 ----
(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,1086 ****
(defun sc-attribs-chop-namestring (namestring)
"Convert NAMESTRING to a list of names.
! example: (sc-namestring-to-list \"John Xavier Doe\")
=> (\"John\" \"Xavier\" \"Doe\")"
(if (string-match "\\([ \t]*\\)\\([^ \t._]+\\)\\([ \t]*\\)" namestring)
! (cons (sc-submatch 2 namestring)
(sc-attribs-chop-namestring (substring namestring (match-end 3)))
)))
--- 987,996 ----
(defun sc-attribs-chop-namestring (namestring)
"Convert NAMESTRING to a list of names.
! example: (sc-attribs-chop-namestring \"John Xavier Doe\")
=> (\"John\" \"Xavier\" \"Doe\")"
(if (string-match "\\([ \t]*\\)\\([^ \t._]+\\)\\([ \t]*\\)" namestring)
! (cons (match-string 2 namestring)
(sc-attribs-chop-namestring (substring namestring (match-end 3)))
)))
***************
*** 1098,1110 ****
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))))
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)
start (match-end 0))
(= start (or (string-match sc-citation-delimiter-regexp string start)
-1))
(setq start (match-end 0))
--- 1008,1021 ----
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 (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 (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,1184 ****
(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))
midname)))
midnames " ")
--- 1084,1092 ----
(lambda (midname)
(let ((key-attribs (format "middlename-%d" n))
(key-mail (format "sc-middlename-%d" n)))
! (push (cons key-attribs midname) sc-attributions)
! (push (cons key-mail midname) sc-mail-info)
! (setq n (1+ n))
midname)))
midnames " ")
***************
*** 1212,1219 ****
sc-mail-info)
))
;; from string is empty
! (setq sc-mail-info (cons (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.")
--- 1120,1126 ----
sc-mail-info)
))
;; from string is empty
! (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.")
***************
*** 1325,1335 ****
(progn
(setq choice
(if sc-attrib-or-cite
! (sc-read-string
"Enter citation prefix: "
citation
'sc-citation-confirmation-history)
! (sc-completing-read
"Complete attribution name: "
query-alist nil nil
(cons initial 0)
--- 1232,1242 ----
(progn
(setq choice
(if sc-attrib-or-cite
! (read-string
"Enter citation prefix: "
citation
'sc-citation-confirmation-history)
! (completing-read
"Complete attribution name: "
query-alist nil nil
(cons initial 0)
***************
*** 1360,1379 ****
(akeyval (assoc akey sc-mail-info)))
(if ckeyval
(setcdr ckeyval citation)
! (setq sc-mail-info
! (append (list (cons ckey citation)) sc-mail-info)))
(if akeyval
(setcdr akeyval attribution)
! (setq sc-mail-info
! (append (list (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))))
))
--- 1267,1283 ----
(akeyval (assoc akey sc-mail-info)))
(if ckeyval
(setcdr ckeyval citation)
! (push (cons ckey citation) sc-mail-info))
(if akeyval
(setcdr akeyval attribution)
! (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)
! (push (cons lkey attribution) sc-attributions)))
))
***************
*** 1426,1439 ****
`begin' frame-entry."
(if (not prefix)
(setq sc-fill-line-prefix ""
! sc-fill-begin (regi-pos 'bol))
(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)))
(setq sc-fill-line-prefix prefix
! sc-fill-begin (regi-pos 'bol))))
)
nil)
--- 1330,1343 ----
`begin' frame-entry."
(if (not prefix)
(setq sc-fill-line-prefix ""
! 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 (line-beginning-position)))
(setq sc-fill-line-prefix prefix
! sc-fill-begin (line-beginning-position))))
)
nil)
***************
*** 1467,1479 ****
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))))
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)
start (match-end 0))
(= start (or (string-match sc-citation-separator-regexp string start)
-1))
nesting)))
--- 1371,1384 ----
supplied, is used instead of the line point is on in the current
buffer."
(let ((start 0)
! (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 (match-string 0 string)
start (match-end 0))
(= start (or (string-match sc-citation-separator-regexp string start)
-1))
nesting)))
***************
*** 1863,1869 ****
(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)
--- 1768,1773 ----
***************
*** 1872,1879 ****
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))
(defun sc-set-variable (var)
"Set the Supercite VARIABLE.
--- 1776,1782 ----
values are changed to nil."
(message "%s changed from %s to %s"
variable (symbol-value variable)
! (set variable (not (symbol-value variable)))))
(defun sc-set-variable (var)
"Set the Supercite VARIABLE.
***************
*** 1886,1926 ****
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))
(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))
(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"))))))
(defmacro sc-setvar-symbol (rootname)
! (list 'defun (intern (concat "sc-S-" rootname)) '()
! (list 'interactive)
! (list 'sc-set-variable
! (list 'quote (intern (concat "sc-" rootname))))))
(sc-toggle-symbol "confirm-always")
(sc-toggle-symbol "downcase")
--- 1789,1823 ----
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))
(myhelp
! (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)
! `(defun ,(intern (concat "sc-T-" rootname)) ()
! (interactive)
! (sc-toggle-var ',(intern (concat "sc-" rootname "-p")))))
(defmacro sc-setvar-symbol (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,1979 ****
(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
;;;###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
original message but it does require a few things:
1) The reply buffer is the current buffer.
--- 1850,1873 ----
(interactive)
(describe-function 'sc-T-describe))
;; ======================================================================
;; published interface to mail and news readers
+ (define-minor-mode sc-minor-mode
+ "Supercite minor mode."
+ nil (" SC" (sc-auto-fill-region-p
+ (":f" (sc-fixup-whitespace-p "w"))
+ (sc-fixup-whitespace-p ":w")))
+ `((,sc-mode-map-prefix . ,sc-mode-map)))
+
;;;###autoload
(defun sc-cite-original ()
"Workhorse citing function which performs the initial citation.
This is callable from the various mail and news readers' reply
! function according to the agreed upon standard. See 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,2022 ****
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)
(undo-boundary)
;; grab point and mark since the region is probably not active when
;; this function gets automatically called. we want point to be a
;; mark so any deleting before point works properly
! (let* ((zmacs-regions nil) ; for Lemacs
(mark-active t) ; for Emacs
(point (point-marker))
(mark (copy-marker (mark-marker))))
--- 1888,1901 ----
before, and `sc-post-hook' is run after the guts of this function."
(run-hooks 'sc-pre-hook)
! (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 XEemacs
(mark-active t) ; for Emacs
(point (point-marker))
(mark (copy-marker (mark-marker))))
***************
*** 2061,2069 ****
(set-marker point nil)
(set-marker mark nil)
)
! (run-hooks 'sc-post-hook)
! ;; post hook could have changed the variables
! (sc-set-mode-string))
;; ======================================================================
--- 1940,1946 ----
(set-marker point nil)
(set-marker mark nil)
)
! (run-hooks 'sc-post-hook))
;; ======================================================================
***************
*** 2077,2083 ****
(let ((start (point))
(prefix (or (progn (beginning-of-line)
(if (looking-at (sc-cite-regexp))
! (sc-submatch 0)))
"")))
(goto-char start)
(open-line arg)
--- 1954,1960 ----
(let ((start (point))
(prefix (or (progn (beginning-of-line)
(if (looking-at (sc-cite-regexp))
! (match-string 0)))
"")))
(goto-char start)
(open-line arg)
***************
*** 2116,2122 ****
"
Supercite is a package which provides a flexible mechanism for citing
email and news replies. Please see the associated texinfo file for
! more information."
(interactive)
(describe-function 'sc-describe))
--- 1993,1999 ----
"
Supercite is a package which provides a flexible mechanism for citing
email and news replies. Please see the associated texinfo file for
! more information. Info node `(SC)Top'."
(interactive)
(describe-function 'sc-describe))
***************
*** 2168,2171 ****
--- 2045,2049 ----
(provide 'supercite)
(run-hooks 'sc-load-hook)
+ ;;; arch-tag: a5d5bfa6-3bd5-4414-8c65-0afc83e45cd3
;;; supercite.el ends here
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] Changes to emacs/lisp/mail/supercite.el [lexbind],
Miles Bader <=