;;; supercite.el --- minor mode for citing mail and news replies
-;; Copyright (C) 1993, 1997, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1997, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
+;; 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: 1993 Barry A. Warsaw <bwarsaw@python.org>
;; Maintainer: Glenn Morris <rgm@gnu.org>
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;; LCD Archive Entry
;; supercite|Barry A. Warsaw|supercite-help@python.org
(concat "\\("
(sc-cite-regexp "")
"\\)"
- (sc-cite-regexp sc-citation-nonnested-root-regexp))
- )))
+ (sc-cite-regexp
+ sc-citation-nonnested-root-regexp)))))
;; blank lines mean paragraph separators, so fill the last cited
;; paragraph, unless sc-cite-blank-lines-p is non-nil, in which
;; case we treat blank lines just like any other line.
;; citations, so cite it with a non-nested citation
(t (sc-cite-line))
;; be sure when we're done that we fill the last cited paragraph.
- (end (sc-fill-if-different ""))
- )
+ (end (sc-fill-if-different "")))
"Default REGI frame for citing a region."
:type '(repeat (repeat sexp))
:group 'supercite-frames)
'(;; do nothing on a blank line
("^[ \t]*$" nil)
;; if the line is cited, uncite it
- ((sc-cite-regexp) (sc-uncite-line))
- )
+ ((sc-cite-regexp) (sc-uncite-line)))
"Default REGI frame for unciting a region."
:type '(repeat (repeat sexp))
:group 'supercite-frames)
;; otherwise, the line is uncited, so just cite it
(t (sc-cite-line))
;; be sure when we're done that we fill the last cited paragraph.
- (end (sc-fill-if-different ""))
- )
+ (end (sc-fill-if-different "")))
"Default REGI frame for reciting a region."
:type '(repeat (repeat sexp))
:group 'supercite-frames)
(sc-header-attributed-writes)
(sc-header-author-writes)
(sc-header-verbose)
- (sc-no-blank-line-or-header)
- )
+ (sc-no-blank-line-or-header))
"List of reference header rewrite functions.
The variable `sc-preferred-header-style' controls which function in
this list is chosen for automatic reference header insertions.
Note that WORD is a string and LETTER is a character. All LETTERs in
the list should be unique."
(let* ((prompt (concat
- (mapconcat (function (lambda (elt) (car elt))) alist ", ")
+ (mapconcat (lambda (elt) (car elt)) alist ", ")
"? ("
(mapconcat
- (function
- (lambda (elt) (char-to-string (cdr elt)))) alist "/")
+ (lambda (elt) (char-to-string (cdr elt))) alist "/")
") "))
(p prompt)
(event
(let* ((elem (car alist))
(infokey (car elem))
(infoval (sc-mail-field infokey))
- (mlist (car (cdr elem))))
+ (mlist (cadr elem)))
(while mlist
(let* ((ml-elem (car mlist))
(regexp (car ml-elem))
mlist nil
alist nil)
;; else we didn't find a match
- (setq mlist (cdr mlist))
- ))) ;end of mlist loop
- (setq alist (cdr alist))
- )) ;end of alist loop
+ (setq mlist (cdr mlist))))) ;end of mlist loop
+ (setq alist (cdr alist)))) ;end of alist loop
rtnvalue))
\f
"For minibuffer completion on mail field modifications.")
(defvar sc-mail-glom-frame
'((begin (setq sc-mail-headers-start (point)))
+ ("^From " (sc-mail-check-from) nil nil)
("^x-attribution:[ \t]+.*$" (sc-mail-fetch-field t) nil t)
("^\\S +:.*$" (sc-mail-fetch-field) nil t)
("^$" (list 'abort '(step . 0)))
(defvar curline) ; dynamic bondage
;; regi functions
+
+;; http://lists.gnu.org/archive/html/emacs-devel/2009-02/msg00691.html
+;; When rmail replies to a message with full headers visible, the "From "
+;; line can be included.
+(defun sc-mail-check-from ()
+ "Deal with a \"From \" line in the header.
+Such a line should only occur at the very start of the headers."
+ (and sc-mail-warn-if-non-rfc822-p
+ (/= (point) sc-mail-headers-start)
+ (sc-mail-error-in-mail-field)))
+
(defun sc-mail-fetch-field (&optional attribs-p)
"Insert a key and value into `sc-mail-info' alist.
If optional ATTRIBS-P is non-nil, the key/value pair is placed in
;; we never get far enough to interpret a frame if s-n-m-h == 'none
((eq sc-nuke-mail-headers 'none))
(t (error "Invalid value for sc-nuke-mail-headers: %s"
- sc-nuke-mail-headers))
- ) ; end-cond
+ sc-nuke-mail-headers))) ; end-cond
(append
(and entry-func
(regi-mapcar sc-nuke-mail-header-list entry-func nil t))
'(("^[ \t]+" (sc-mail-nuke-continuation-line))))
'((begin (setq sc-mail-last-header-zapped-p nil)))
'((end (sc-mail-cleanup-blank-lines)))
- (and every-func (list (list 'every every-func)))
- )))
+ (and every-func (list (list 'every every-func))))))
;; mail processing and zapping. this is the top level entry defun to
;; all header processing.
(setq sc-mail-info info
sc-attributions attribs))
(regi-interpret (sc-mail-build-nuke-frame)
- sc-mail-headers-start sc-mail-headers-end)
- )))
+ sc-mail-headers-start sc-mail-headers-end))))
\f
;; let the user change mail field information
(concat key ": ") (cdr keyval)
'sc-mail-field-modification-history))))
((eq action ?a)
- (push (cons key (read-string (concat key ": "))) sc-mail-info))
- ))))
+ (push (cons key (read-string (concat key ": "))) sc-mail-info))))))
\f
;; ======================================================================
from 0))
(mend (match-end 0)))
(and mstart
- (substring from (1+ mstart) (- mend (if (= mend eos) 0 1)))
- )))
+ (substring from (1+ mstart) (- mend (if (= mend eos) 0 1))))))
(defun sc-attribs-<>-addresses (from)
"Extract the author's email terminus from email address FROM.
address))
(if (string-match "[-[:alnum:]!@%._]+" from 0)
(match-string 0 from)
- "")
- )))
+ ""))))
(defun sc-attribs-emailname (from)
"Get the email terminus name from FROM."
(let ((sos (+ start extend))
(eos (- end extend)))
(substring string sos
- (or (string-match sc-titlecue-regexp string sos) eos)
- ))))
+ (or (string-match sc-titlecue-regexp string sos) eos)))))
(defun sc-attribs-extract-namestring (from)
"Extract the name string from FROM.
=> (\"John\" \"Xavier\" \"Doe\")"
(if (string-match "\\([ \t]*\\)\\([^ \t._]+\\)\\([ \t]*\\)" namestring)
(cons (match-string 2 namestring)
- (sc-attribs-chop-namestring (substring namestring (match-end 3)))
- )))
+ (sc-attribs-chop-namestring (substring namestring (match-end 3))))))
(defun sc-attribs-strip-initials (namelist)
"Extract the author's initials from the NAMELIST."
(mapconcat
- (function
- (lambda (name)
- (if (< 0 (length name))
- (substring name 0 1))))
+ (lambda (name)
+ (if (< 0 (length name))
+ (substring name 0 1)))
namelist ""))
(defun sc-guess-attribution (&optional string)
(position -1)
keepers filtered-list)
(mapc
- (function
- (lambda (name)
- (setq position (1+ position))
- (let ((keep-p t))
- (mapc
- (function
- (lambda (filter)
- (let ((regexp (car filter))
- (pos (cdr filter)))
- (if (and (string-match regexp name)
- (or (and (numberp pos)
- (= pos position))
- (and (eq pos 'last)
- (= position (1- elements)))
- (eq pos 'any)))
- (setq keep-p nil))
- )))
- sc-name-filter-alist)
- (if keep-p
- (setq keepers (cons position keepers)))
- )))
+ (lambda (name)
+ (setq position (1+ position))
+ (let ((keep-p t))
+ (mapc
+ (function
+ (lambda (filter)
+ (let ((regexp (car filter))
+ (pos (cdr filter)))
+ (if (and (string-match regexp name)
+ (or (and (numberp pos)
+ (= pos position))
+ (and (eq pos 'last)
+ (= position (1- elements)))
+ (eq pos 'any)))
+ (setq keep-p nil)))))
+ sc-name-filter-alist)
+ (if keep-p
+ (setq keepers (cons position keepers)))))
namelist)
(mapc
- (function
- (lambda (position)
- (setq filtered-list (cons (nth position namelist) filtered-list))
- ))
+ (lambda (position)
+ (setq filtered-list (cons (nth position namelist) filtered-list)))
keepers)
filtered-list))
(setq
;; put middle names and build sc-author entry
middlenames (mapconcat
- (function
- (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)))
+ (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 " ")
author (concat firstname " " middlenames (and midnames " ") lastname)
namestring))
(cons "sc-sender-address" (sc-get-address
(sc-mail-field "sender")
- namestring))
- )
- sc-mail-info)
- ))
+ namestring)))
+ sc-mail-info)))
;; from string is empty
(push (cons "sc-author" sc-default-author-name) sc-mail-info)))
(setq attribution nil
attriblist (cdr attriblist))))
(t (error "%s did not evaluate to a string or list!"
- "sc-attrib-selection-list"))
- )))
+ "sc-attrib-selection-list")))))
((setq attribution (cdr (assoc preferred sc-attributions)))
(setq attriblist nil))
(t
- (setq attriblist (cdr attriblist)))
- )))
+ (setq attriblist (cdr attriblist))))))
;; if preference was not found, we may use a secondary method to
;; find a valid attribution
;; query for confirmation
(if query-p
- (let* ((query-alist (mapcar (function (lambda (entry)
- (list (cdr entry))))
+ (let* ((query-alist (mapcar (lambda (entry) (list (cdr entry)))
sc-attributions))
(minibuffer-local-completion-map
sc-minibuffer-local-completion-map)
"Complete attribution name: "
query-alist nil nil
(cons initial 0)
- 'sc-attribution-confirmation-history)
- ))
+ 'sc-attribution-confirmation-history)))
nil)))
(if sc-attrib-or-cite
;; since the citation was chosen, we have to guess at
citation))
(setq citation (sc-make-citation choice)
- attribution choice))
- ))
+ attribution choice))))
;; its possible that the user wants to downcase the citation and
;; attribution
(lastchoice (assoc lkey sc-attributions)))
(if lastchoice
(setcdr lastchoice attribution)
- (push (cons lkey attribution) sc-attributions)))
- ))
+ (push (cons lkey attribution) sc-attributions)))))
\f
;; ======================================================================
(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))))
- )
+ sc-fill-begin (line-beginning-position)))))
nil)
(defun sc-cite-coerce-cited-line ()
(sc-mail-field "subject") "\n")
(sc-hdr (concat tag "(see ")
(sc-mail-field "references")
- " for more details)\n")
- ))))
+ " for more details)\n")))))
\f
;; ======================================================================
(void-function
(progn (message
"Symbol's function definition is void: %s (Header %d)"
- (car (cdr err)) sc-eref-style)
- (beep)
- ))
- )))
+ (cadr err) sc-eref-style)
+ (beep))))))
(defun sc-electric-mode (&optional arg)
"
(use-local-map sc-electric-mode-map)
(sc-eref-show sc-eref-style)
(run-mode-hooks 'sc-electric-mode-hook)
- (recursive-edit)
- )))
+ (recursive-edit))))
(and sc-eref-style
(sc-eref-insert-selected))
- (kill-buffer sc-electric-bufname)
- ))
+ (kill-buffer sc-electric-bufname)))
;; functions for electric reference mode
(defun sc-eref-show (index)
((>= index last)
(if sc-electric-circular-p
0
- (progn (error msg "follow") (1- last))))
- ))
- (save-excursion
- (set-buffer sc-electric-bufname)
- (let ((buffer-read-only nil))
- (erase-buffer)
- (goto-char (point-min))
- (sc-eref-insert-selected)
- ;; now shrink the window to just contain the electric reference
- ;; header.
- (let ((hdrlines (count-lines (point-min) (point-max)))
- (winlines (1- (window-height))))
- (if (/= hdrlines winlines)
- (if (> hdrlines winlines)
- ;; we have to enlarge the window
- (enlarge-window (- hdrlines winlines))
- ;; we have to shrink the window
- (shrink-window (- winlines (max hdrlines window-min-height)))
- )))
- ))))
+ (progn (error msg "follow") (1- last))))))
+ (with-current-buffer sc-electric-bufname
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (goto-char (point-min))
+ (sc-eref-insert-selected)
+ ;; now shrink the window to just contain the electric reference
+ ;; header.
+ (let ((hdrlines (count-lines (point-min) (point-max)))
+ (winlines (1- (window-height))))
+ (if (/= hdrlines winlines)
+ (if (> hdrlines winlines)
+ ;; we have to enlarge the window
+ (enlarge-window (- hdrlines winlines))
+ ;; we have to shrink the window
+ (shrink-window (- winlines (max hdrlines
+ window-min-height))))))))))
(defun sc-eref-next ()
"Display next reference in other buffer."
(if (sc-valid-index-p refnum)
(sc-eref-show refnum)
(error "Invalid reference: %d. (Range: [%d .. %d])"
- refnum 0 (1- (length sc-rewrite-header-list)))
- ))
+ refnum 0 (1- (length sc-rewrite-header-list)))))
(defun sc-eref-jump ()
"Set reference header to preferred header."
0)))
(if sc-electric-references-p
(sc-electric-mode preference)
- (sc-eref-insert-selected t)
- ))))
+ (sc-eref-insert-selected t)))))
\f
;; ======================================================================
;; finally, free the point-marker
(set-marker point nil)
- (set-marker mark nil)
- )
+ (set-marker mark nil))
(run-hooks 'sc-post-hook))
\f
(insert (sc-mail-field "sc-citation"))
(error "Line is already cited"))))
+;; The argument logic here is crazy.
(defun sc-version (message)
- "Echo the current version of Supercite in the minibuffer.
+ "Return the current Supercite version.
If MESSAGE is non-nil (interactively, with no prefix argument),
-inserts the version string in the current buffer instead."
- (interactive (not current-prefix-arg))
+echoes the version in the minibuffer. Otherwise, inserts the
+version at point."
+ (interactive (list (not current-prefix-arg)))
(let ((verstr (format "Using Supercite.el %s" emacs-version)))
(if message
(message verstr)