|
4850
|
1 ;;; supercite.el --- minor mode for citing mail and news replies
|
|
|
2
|
102154
3da2fdefd254
(sc-mail-glom-frame): Handle a "From " line at the start of the headers.
Glenn Morris <rgm@gnu.org>
diff
changeset
|
3 ;; Copyright (C) 1993, 1997, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
|
3da2fdefd254
(sc-mail-glom-frame): Handle a "From " line at the start of the headers.
Glenn Morris <rgm@gnu.org>
diff
changeset
|
4 ;; 2008, 2009 Free Software Foundation, Inc.
|
|
12859
|
5
|
|
57160
|
6 ;; Author: 1993 Barry A. Warsaw <bwarsaw@python.org>
|
|
65919
|
7 ;; Maintainer: Glenn Morris <rgm@gnu.org>
|
|
4850
|
8 ;; Created: February 1993
|
|
5140
|
9 ;; Keywords: mail, news
|
|
4850
|
10
|
|
|
11 ;; This file is part of GNU Emacs.
|
|
|
12
|
|
94674
|
13 ;; GNU Emacs is free software: you can redistribute it and/or modify
|
|
4850
|
14 ;; it under the terms of the GNU General Public License as published by
|
|
94674
|
15 ;; the Free Software Foundation, either version 3 of the License, or
|
|
|
16 ;; (at your option) any later version.
|
|
4850
|
17
|
|
|
18 ;; GNU Emacs is distributed in the hope that it will be useful,
|
|
|
19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
21 ;; GNU General Public License for more details.
|
|
|
22
|
|
|
23 ;; You should have received a copy of the GNU General Public License
|
|
94674
|
24 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
|
4850
|
25
|
|
|
26 ;; LCD Archive Entry
|
|
24612
|
27 ;; supercite|Barry A. Warsaw|supercite-help@python.org
|
|
4850
|
28 ;; |Mail and news reply citation package
|
|
|
29 ;; |1993/09/22 18:58:46|3.1|
|
|
|
30
|
|
38436
|
31 ;;; Commentary:
|
|
|
32
|
|
|
33 ;;; Code:
|
|
4850
|
34
|
|
|
35
|
|
|
36 (require 'regi)
|
|
21861
|
37 (require 'sendmail) ;; For mail-header-end.
|
|
4850
|
38
|
|
|
39 ;; start user configuration variables
|
|
|
40 ;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
|
|
|
41
|
|
17489
|
42 (defgroup supercite nil
|
64037
72c3c77d111e
(supercite, supercite-frames, supercite-attr, supercite-cite, supercite-hooks):
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
43 "Supercite package."
|
|
17489
|
44 :prefix "sc-"
|
|
|
45 :group 'mail
|
|
|
46 :group 'news)
|
|
|
47
|
|
|
48 (defgroup supercite-frames nil
|
64037
72c3c77d111e
(supercite, supercite-frames, supercite-attr, supercite-cite, supercite-hooks):
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
49 "Supercite (regi) frames."
|
|
17489
|
50 :prefix "sc-"
|
|
|
51 :group 'supercite)
|
|
4850
|
52
|
|
17489
|
53 (defgroup supercite-attr nil
|
64037
72c3c77d111e
(supercite, supercite-frames, supercite-attr, supercite-cite, supercite-hooks):
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
54 "Supercite attributions."
|
|
17489
|
55 :prefix "sc-"
|
|
|
56 :group 'supercite)
|
|
|
57
|
|
|
58 (defgroup supercite-cite nil
|
64037
72c3c77d111e
(supercite, supercite-frames, supercite-attr, supercite-cite, supercite-hooks):
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
59 "Supercite citings."
|
|
17489
|
60 :prefix "sc-"
|
|
|
61 :group 'supercite)
|
|
|
62
|
|
|
63 (defgroup supercite-hooks nil
|
64037
72c3c77d111e
(supercite, supercite-frames, supercite-attr, supercite-cite, supercite-hooks):
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
64 "Hooking into supercite."
|
|
17489
|
65 :prefix "sc-"
|
|
|
66 :group 'supercite)
|
|
4850
|
67
|
|
17489
|
68 (defcustom sc-auto-fill-region-p t
|
|
92543
|
69 "If non-nil, automatically fill each paragraph after it has been cited."
|
|
17489
|
70 :type 'boolean
|
|
|
71 :group 'supercite)
|
|
|
72
|
|
|
73 (defcustom sc-blank-lines-after-headers 1
|
|
92543
|
74 "Number of blank lines to leave after mail headers have been nuked.
|
|
17489
|
75 Set to nil, to use whatever blank lines happen to occur naturally."
|
|
|
76 :type '(choice (const :tag "leave" nil)
|
|
|
77 integer)
|
|
|
78 :group 'supercite)
|
|
|
79
|
|
|
80 (defcustom sc-citation-leader " "
|
|
92543
|
81 "String comprising first part of a citation."
|
|
17489
|
82 :type 'string
|
|
|
83 :group 'supercite-cite)
|
|
|
84
|
|
|
85 (defcustom sc-citation-delimiter ">"
|
|
92543
|
86 "String comprising third part of a citation.
|
|
17489
|
87 This string is used in both nested and non-nested citations."
|
|
|
88 :type 'string
|
|
|
89 :group 'supercite-cite)
|
|
4850
|
90
|
|
17489
|
91 (defcustom sc-citation-separator " "
|
|
92543
|
92 "String comprising fourth and last part of a citation."
|
|
17489
|
93 :type 'string
|
|
|
94 :group 'supercite-cite)
|
|
|
95
|
|
|
96 (defcustom sc-citation-leader-regexp "[ \t]*"
|
|
92543
|
97 "Regexp describing citation leader for a cited line.
|
|
17489
|
98 This should NOT have a leading `^' character."
|
|
|
99 :type 'regexp
|
|
|
100 :group 'supercite-cite)
|
|
4850
|
101
|
|
|
102 ;; Nemacs and Mule users note: please see the texinfo manual for
|
|
|
103 ;; suggestions on setting these variables.
|
|
28437
|
104 (defcustom sc-citation-root-regexp "[-._[:alnum:]]*"
|
|
92543
|
105 "Regexp describing variable root part of a citation for a cited line.
|
|
4850
|
106 This should NOT have a leading `^' character. See also
|
|
17489
|
107 `sc-citation-nonnested-root-regexp'."
|
|
|
108 :type 'regexp
|
|
|
109 :group 'supercite-cite)
|
|
|
110
|
|
28437
|
111 (defcustom sc-citation-nonnested-root-regexp "[-._[:alnum:]]+"
|
|
92543
|
112 "Regexp describing the variable root part of a nested citation.
|
|
4850
|
113 This should NOT have a leading `^' character. This variable is
|
|
14007
|
114 related to `sc-citation-root-regexp' but whereas that variable
|
|
4850
|
115 describes both nested and non-nested citation roots, this variable
|
|
17489
|
116 describes only nested citation roots."
|
|
|
117 :type 'regexp
|
|
|
118 :group 'supercite-cite)
|
|
|
119
|
|
|
120 (defcustom sc-citation-delimiter-regexp "[>]+"
|
|
92543
|
121 "Regexp describing citation delimiter for a cited line.
|
|
17489
|
122 This should NOT have a leading `^' character."
|
|
|
123 :type 'regexp
|
|
|
124 :group 'supercite-cite)
|
|
|
125
|
|
|
126 (defcustom sc-citation-separator-regexp "[ \t]*"
|
|
92543
|
127 "Regexp describing citation separator for a cited line.
|
|
17489
|
128 This should NOT have a leading `^' character."
|
|
|
129 :type 'regexp
|
|
|
130 :group 'supercite-cite)
|
|
4850
|
131
|
|
17489
|
132 (defcustom sc-cite-blank-lines-p nil
|
|
92543
|
133 "If non-nil, put a citation on blank lines."
|
|
17489
|
134 :type 'boolean
|
|
|
135 :group 'supercite-cite)
|
|
4850
|
136
|
|
17489
|
137 (defcustom sc-cite-frame-alist '()
|
|
92543
|
138 "Alist for frame selection during citing.
|
|
4850
|
139 Each element of this list has the following form:
|
|
|
140 (INFOKEY ((REGEXP . FRAME)
|
|
|
141 (REGEXP . FRAME)
|
|
|
142 (...)))
|
|
|
143
|
|
|
144 Where INFOKEY is a key for `sc-mail-field', REGEXP is a regular
|
|
58952
|
145 expression to match against the INFOKEY's value. FRAME is
|
|
|
146 a citation frame, or a symbol that represents the name of
|
|
|
147 a variable whose value is a citation frame."
|
|
17489
|
148 :type '(repeat (list symbol (repeat (cons regexp
|
|
|
149 (choice (repeat (repeat sexp))
|
|
|
150 symbol)))))
|
|
|
151 :group 'supercite-frames)
|
|
62315
|
152 (put 'sc-cite-frame-alist 'risky-local-variable t)
|
|
17489
|
153
|
|
|
154 (defcustom sc-uncite-frame-alist '()
|
|
92543
|
155 "Alist for frame selection during unciting.
|
|
17489
|
156 See the variable `sc-cite-frame-alist' for details."
|
|
|
157 :type '(repeat (list symbol (repeat (cons regexp
|
|
|
158 (choice (repeat (repeat sexp))
|
|
|
159 symbol)))))
|
|
|
160 :group 'supercite-frames)
|
|
62315
|
161 (put 'sc-uncite-frame-alist 'risky-local-variable t)
|
|
17489
|
162
|
|
|
163 (defcustom sc-recite-frame-alist '()
|
|
92543
|
164 "Alist for frame selection during reciting.
|
|
17489
|
165 See the variable `sc-cite-frame-alist' for details."
|
|
|
166 :type '(repeat (list symbol (repeat (cons regexp
|
|
|
167 (choice (repeat (repeat sexp))
|
|
|
168 symbol)))))
|
|
|
169 :group 'supercite-frames)
|
|
62315
|
170 (put 'sc-recite-frame-alist 'risky-local-variable t)
|
|
4850
|
171
|
|
17489
|
172 (defcustom sc-default-cite-frame
|
|
4850
|
173 '(;; initialize fill state and temporary variables when entering
|
|
|
174 ;; frame. this makes things run much faster
|
|
|
175 (begin (progn
|
|
|
176 (sc-fill-if-different)
|
|
|
177 (setq sc-tmp-nested-regexp (sc-cite-regexp "")
|
|
|
178 sc-tmp-nonnested-regexp (sc-cite-regexp)
|
|
|
179 sc-tmp-dumb-regexp
|
|
|
180 (concat "\\("
|
|
|
181 (sc-cite-regexp "")
|
|
|
182 "\\)"
|
|
92814
|
183 (sc-cite-regexp
|
|
|
184 sc-citation-nonnested-root-regexp)))))
|
|
4850
|
185 ;; blank lines mean paragraph separators, so fill the last cited
|
|
|
186 ;; paragraph, unless sc-cite-blank-lines-p is non-nil, in which
|
|
|
187 ;; case we treat blank lines just like any other line.
|
|
|
188 ("^[ \t]*$" (if sc-cite-blank-lines-p
|
|
|
189 (sc-cite-line)
|
|
|
190 (sc-fill-if-different "")))
|
|
|
191 ;; do nothing if looking at a reference tag. make sure that the
|
|
|
192 ;; tag string isn't the empty string since this will match every
|
|
|
193 ;; line. it cannot be nil.
|
|
|
194 (sc-reference-tag-string (if (string= sc-reference-tag-string "")
|
|
|
195 (list 'continue)
|
|
|
196 nil))
|
|
|
197 ;; this regexp catches nested citations in which the author cited
|
|
|
198 ;; a non-nested citation with a dumb citer.
|
|
|
199 (sc-tmp-dumb-regexp (sc-cite-coerce-dumb-citer))
|
|
|
200 ;; if we are looking at a nested citation then add a citation level
|
|
|
201 (sc-tmp-nested-regexp (sc-add-citation-level))
|
|
|
202 ;; if we're looking at a non-nested citation, coerce it to our style
|
|
|
203 (sc-tmp-nonnested-regexp (sc-cite-coerce-cited-line))
|
|
|
204 ;; we must be looking at an uncited line. if we are in nested
|
|
|
205 ;; citations, just add a citation level
|
|
|
206 (sc-nested-citation-p (sc-add-citation-level))
|
|
|
207 ;; we're looking at an uncited line and we are in non-nested
|
|
|
208 ;; citations, so cite it with a non-nested citation
|
|
|
209 (t (sc-cite-line))
|
|
|
210 ;; be sure when we're done that we fill the last cited paragraph.
|
|
92814
|
211 (end (sc-fill-if-different "")))
|
|
92543
|
212 "Default REGI frame for citing a region."
|
|
17489
|
213 :type '(repeat (repeat sexp))
|
|
|
214 :group 'supercite-frames)
|
|
62315
|
215 (put 'sc-default-cite-frame 'risky-local-variable t)
|
|
4850
|
216
|
|
17489
|
217 (defcustom sc-default-uncite-frame
|
|
4850
|
218 '(;; do nothing on a blank line
|
|
|
219 ("^[ \t]*$" nil)
|
|
|
220 ;; if the line is cited, uncite it
|
|
92814
|
221 ((sc-cite-regexp) (sc-uncite-line)))
|
|
92543
|
222 "Default REGI frame for unciting a region."
|
|
17489
|
223 :type '(repeat (repeat sexp))
|
|
|
224 :group 'supercite-frames)
|
|
62315
|
225 (put 'sc-default-uncite-frame 'risky-local-variable t)
|
|
4850
|
226
|
|
17489
|
227 (defcustom sc-default-recite-frame
|
|
4850
|
228 '(;; initialize fill state when entering frame
|
|
|
229 (begin (sc-fill-if-different))
|
|
|
230 ;; do nothing on a blank line
|
|
|
231 ("^[ \t]*$" nil)
|
|
|
232 ;; if we're looking at a cited line, recite it
|
|
|
233 ((sc-cite-regexp) (sc-recite-line (sc-cite-regexp)))
|
|
|
234 ;; otherwise, the line is uncited, so just cite it
|
|
|
235 (t (sc-cite-line))
|
|
|
236 ;; be sure when we're done that we fill the last cited paragraph.
|
|
92814
|
237 (end (sc-fill-if-different "")))
|
|
92543
|
238 "Default REGI frame for reciting a region."
|
|
17489
|
239 :type '(repeat (repeat sexp))
|
|
|
240 :group 'supercite-frames)
|
|
62315
|
241 (put 'sc-default-recite-frame 'risky-local-variable t)
|
|
4850
|
242
|
|
17489
|
243 (defcustom sc-cite-region-limit t
|
|
92543
|
244 "This variable controls automatic citation of yanked text.
|
|
60924
|
245 Valid values are:
|
|
4850
|
246
|
|
|
247 non-nil -- cite the entire region, regardless of its size
|
|
|
248 nil -- do not cite the region at all
|
|
|
249 <integer> -- a number indicating the threshold for citation. When
|
|
|
250 the number of lines in the region is greater than this
|
|
|
251 value, a warning message will be printed and the region
|
|
|
252 will not be cited. Lines in region are counted with
|
|
49598
|
253 `count-lines'.
|
|
4850
|
254
|
|
|
255 The gathering of attribution information is not affected by the value
|
|
|
256 of this variable. The number of lines in the region is calculated
|
|
|
257 *after* all mail headers are removed. This variable is only consulted
|
|
17489
|
258 during the initial citing via `sc-cite-original'."
|
|
22592
|
259 :type '(choice (const :tag "do not cite" nil)
|
|
|
260 (integer :tag "citation threshold")
|
|
|
261 (other :tag "always cite" t))
|
|
17489
|
262 :group 'supercite-cite)
|
|
4850
|
263
|
|
17489
|
264 (defcustom sc-confirm-always-p t
|
|
92543
|
265 "If non-nil, always confirm attribution string before citing text body."
|
|
17489
|
266 :type 'boolean
|
|
|
267 :group 'supercite-attr)
|
|
4850
|
268
|
|
17489
|
269 (defcustom sc-default-attribution "Anon"
|
|
92543
|
270 "String used when author's attribution cannot be determined."
|
|
17489
|
271 :type 'string
|
|
|
272 :group 'supercite-attr)
|
|
|
273 (defcustom sc-default-author-name "Anonymous"
|
|
92543
|
274 "String used when author's name cannot be determined."
|
|
17489
|
275 :type 'string
|
|
|
276 :group 'supercite-attr)
|
|
|
277 (defcustom sc-downcase-p nil
|
|
92543
|
278 "Non-nil means downcase the attribution and citation strings."
|
|
17489
|
279 :type 'boolean
|
|
|
280 :group 'supercite-attr
|
|
|
281 :group 'supercite-cite)
|
|
|
282 (defcustom sc-electric-circular-p t
|
|
92543
|
283 "If non-nil, treat electric references as circular."
|
|
17489
|
284 :type 'boolean
|
|
|
285 :group 'supercite-attr)
|
|
4850
|
286
|
|
17489
|
287 (defcustom sc-electric-mode-hook nil
|
|
92543
|
288 "Hook for `sc-electric-mode' electric references mode."
|
|
17489
|
289 :type 'hook
|
|
|
290 :group 'supercite-hooks)
|
|
|
291 (defcustom sc-electric-references-p nil
|
|
92543
|
292 "Use electric references if non-nil."
|
|
17489
|
293 :type 'boolean
|
|
|
294 :group 'supercite)
|
|
4850
|
295
|
|
17489
|
296 (defcustom sc-fixup-whitespace-p nil
|
|
92543
|
297 "If non-nil, delete all leading white space before citing."
|
|
17489
|
298 :type 'boolean
|
|
|
299 :group 'supercite)
|
|
4850
|
300
|
|
17489
|
301 (defcustom sc-load-hook nil
|
|
92543
|
302 "Hook which gets run once after Supercite loads."
|
|
17489
|
303 :type 'hook
|
|
|
304 :group 'supercite-hooks)
|
|
|
305 (defcustom sc-pre-hook nil
|
|
92543
|
306 "Hook which gets run before each invocation of `sc-cite-original'."
|
|
17489
|
307 :type 'hook
|
|
|
308 :group 'supercite-hooks)
|
|
|
309 (defcustom sc-post-hook nil
|
|
92543
|
310 "Hook which gets run after each invocation of `sc-cite-original'."
|
|
17489
|
311 :type 'hook
|
|
|
312 :group 'supercite-hooks)
|
|
4850
|
313
|
|
17489
|
314 (defcustom sc-mail-warn-if-non-rfc822-p t
|
|
92543
|
315 "Warn if mail headers don't conform to RFC822."
|
|
17489
|
316 :type 'boolean
|
|
|
317 :group 'supercite-attr)
|
|
|
318 (defcustom sc-mumble ""
|
|
92543
|
319 "Value returned by `sc-mail-field' if field isn't in mail headers."
|
|
17489
|
320 :type 'string
|
|
|
321 :group 'supercite-attr)
|
|
4850
|
322
|
|
17489
|
323 (defcustom sc-name-filter-alist
|
|
4850
|
324 '(("^\\(Mr\\|Mrs\\|Ms\\|Dr\\)[.]?$" . 0)
|
|
|
325 ("^\\(Jr\\|Sr\\)[.]?$" . last)
|
|
|
326 ("^ASTS$" . 0)
|
|
|
327 ("^[I]+$" . last))
|
|
92543
|
328 "Name list components which are filtered out as noise.
|
|
4850
|
329 This variable contains an association list where each element is of
|
|
|
330 the form: (REGEXP . POSITION).
|
|
|
331
|
|
|
332 REGEXP is a regular expression which matches the name list component.
|
|
|
333 Match is performed using `string-match'. POSITION is the position in
|
|
|
334 the name list which can match the regular expression, starting at zero
|
|
|
335 for the first element. Use `last' to match the last element in the
|
|
17489
|
336 list and `any' to match all elements."
|
|
|
337 :type '(repeat (cons regexp (choice (const last) (const any)
|
|
|
338 (integer :tag "position"))))
|
|
|
339 :group 'supercite-attr)
|
|
4850
|
340
|
|
17489
|
341 (defcustom sc-nested-citation-p nil
|
|
92543
|
342 "Controls whether to use nested or non-nested citation style.
|
|
17489
|
343 Non-nil uses nested citations, nil uses non-nested citations."
|
|
|
344 :type 'boolean
|
|
|
345 :group 'supercite)
|
|
4850
|
346
|
|
17489
|
347 (defcustom sc-nuke-mail-headers 'all
|
|
92543
|
348 "Controls mail header nuking.
|
|
60924
|
349 Used in conjunction with `sc-nuke-mail-header-list'. Valid values are:
|
|
4850
|
350
|
|
|
351 `all' -- nuke all mail headers
|
|
|
352 `none' -- don't nuke any mail headers
|
|
|
353 `specified' -- nuke headers specified in `sc-nuke-mail-header-list'
|
|
17489
|
354 `keep' -- keep headers specified in `sc-nuke-mail-header-list'"
|
|
|
355 :type '(choice (const all) (const none)
|
|
|
356 (const specified) (const keep))
|
|
|
357 :group 'supercite)
|
|
4850
|
358
|
|
17489
|
359 (defcustom sc-nuke-mail-header-list nil
|
|
92543
|
360 "List of mail header regexps to remove or keep in body of reply.
|
|
4850
|
361 This list contains regular expressions describing the mail headers to
|
|
17489
|
362 keep or nuke, depending on the value of `sc-nuke-mail-headers'."
|
|
|
363 :type '(repeat regexp)
|
|
|
364 :group 'supercite)
|
|
4850
|
365
|
|
17489
|
366 (defcustom sc-preferred-attribution-list
|
|
4850
|
367 '("sc-lastchoice" "x-attribution" "firstname" "initials" "lastname")
|
|
92543
|
368 "Specifies what to use as the attribution string.
|
|
4850
|
369 Supercite creates a list of possible attributions when it scans the
|
|
|
370 mail headers from the original message. Each attribution choice is
|
|
|
371 associated with a key in an attribution alist. Supercite tries to
|
|
|
372 pick a \"preferred\" attribution by matching the attribution alist
|
|
|
373 keys against the elements in `sc-preferred-attribution-list' in order.
|
|
|
374 The first non-empty string value found is used as the preferred
|
|
|
375 attribution.
|
|
|
376
|
|
|
377 Note that Supercite now honors the X-Attribution: mail field. If
|
|
|
378 present in the original message, the value of this field should always
|
|
|
379 be used to select the most preferred attribution since it reflects how
|
|
|
380 the original author would like to be distinguished. It should be
|
|
|
381 considered bad taste to put any attribution preference key before
|
|
|
382 \"x-attribution\" in this list, except perhaps for \"sc-lastchoice\"
|
|
7639
|
383 \(see below).
|
|
4850
|
384
|
|
|
385 Supercite remembers the last attribution used when reciting an already
|
|
|
386 cited paragraph. This attribution will always be saved with the
|
|
|
387 \"sc-lastchoice\" key, which can be used in this list. Note that the
|
|
|
388 last choice is always reset after every call of `sc-cite-original'.
|
|
|
389
|
|
|
390 Barring error conditions, the following preferences are always present
|
|
|
391 in the attribution alist:
|
|
|
392
|
|
|
393 \"emailname\" -- email terminus name
|
|
|
394 \"initials\" -- initials of author
|
|
|
395 \"firstname\" -- first name of author
|
|
|
396 \"lastname\" -- last name of author
|
|
|
397 \"middlename-1\" -- first middle name of author
|
|
|
398 \"middlename-2\" -- second middle name of author
|
|
|
399 ...
|
|
|
400
|
|
|
401 Middle name indexes can be any positive integer greater than 0,
|
|
|
402 although it is unlikely that many authors will supply more than one
|
|
|
403 middle name, if that many. The string of all middle names is
|
|
17489
|
404 associated with the key \"middlenames\"."
|
|
|
405 :type '(repeat string)
|
|
|
406 :group 'supercite-attr)
|
|
4850
|
407
|
|
17489
|
408 (defcustom sc-attrib-selection-list nil
|
|
92543
|
409 "An alist for selecting preferred attribution based on mail headers.
|
|
4850
|
410 Each element of this list has the following form:
|
|
|
411
|
|
|
412 (INFOKEY ((REGEXP . ATTRIBUTION)
|
|
|
413 (REGEXP . ATTRIBUTION)
|
|
|
414 (...)))
|
|
|
415
|
|
|
416 Where INFOKEY is a key for `sc-mail-field', REGEXP is a regular
|
|
75514
|
417 expression to match against the INFOKEY's value. ATTRIBUTION can be a
|
|
|
418 string or a list. If it's a string, then it is the attribution that is
|
|
4850
|
419 selected by `sc-select-attribution'. If it is a list, it is `eval'd
|
|
|
420 and the return value must be a string, which is used as the selected
|
|
|
421 attribution. Note that the variable `sc-preferred-attribution-list'
|
|
|
422 must contain an element of the string \"sc-consult\" for this variable
|
|
17489
|
423 to be consulted during attribution selection."
|
|
24613
|
424 :type '(repeat (list string
|
|
|
425 (repeat (cons regexp
|
|
|
426 (choice (sexp :tag "List to eval")
|
|
|
427 string)))))
|
|
17489
|
428 :group 'supercite-attr)
|
|
62315
|
429 (put 'sc-attrib-selection-list 'risky-local-variable t)
|
|
4850
|
430
|
|
17489
|
431 (defcustom sc-attribs-preselect-hook nil
|
|
92543
|
432 "Hook to run before selecting an attribution."
|
|
17489
|
433 :type 'hook
|
|
|
434 :group 'supercite-attr
|
|
|
435 :group 'supercite-hooks)
|
|
|
436 (defcustom sc-attribs-postselect-hook nil
|
|
92543
|
437 "Hook to run after selecting an attribution, but before confirmation."
|
|
17489
|
438 :type 'hook
|
|
|
439 :group 'supercite-attr
|
|
|
440 :group 'supercite-hooks)
|
|
4850
|
441
|
|
17489
|
442 (defcustom sc-pre-cite-hook nil
|
|
92543
|
443 "Hook to run before citing a region of text."
|
|
17489
|
444 :type 'hook
|
|
|
445 :group 'supercite-cite
|
|
|
446 :group 'supercite-hooks)
|
|
|
447 (defcustom sc-pre-uncite-hook nil
|
|
92543
|
448 "Hook to run before unciting a region of text."
|
|
17489
|
449 :type 'hook
|
|
|
450 :group 'supercite-cite
|
|
|
451 :group 'supercite-hooks)
|
|
|
452 (defcustom sc-pre-recite-hook nil
|
|
92543
|
453 "Hook to run before reciting a region of text."
|
|
17489
|
454 :type 'hook
|
|
|
455 :group 'supercite-cite
|
|
|
456 :group 'supercite-hooks)
|
|
4850
|
457
|
|
17489
|
458 (defcustom sc-preferred-header-style 4
|
|
92543
|
459 "Index into `sc-rewrite-header-list' specifying preferred header style.
|
|
17489
|
460 Index zero accesses the first function in the list."
|
|
|
461 :type 'integer
|
|
|
462 :group 'supercite)
|
|
4850
|
463
|
|
17489
|
464 (defcustom sc-reference-tag-string ">>>>> "
|
|
92543
|
465 "String used at the beginning of built-in reference headers."
|
|
17489
|
466 :type 'string
|
|
|
467 :group 'supercite)
|
|
4850
|
468
|
|
17489
|
469 (defcustom sc-rewrite-header-list
|
|
4850
|
470 '((sc-no-header)
|
|
|
471 (sc-header-on-said)
|
|
|
472 (sc-header-inarticle-writes)
|
|
|
473 (sc-header-regarding-adds)
|
|
|
474 (sc-header-attributed-writes)
|
|
|
475 (sc-header-author-writes)
|
|
|
476 (sc-header-verbose)
|
|
92814
|
477 (sc-no-blank-line-or-header))
|
|
92543
|
478 "List of reference header rewrite functions.
|
|
4850
|
479 The variable `sc-preferred-header-style' controls which function in
|
|
|
480 this list is chosen for automatic reference header insertions.
|
|
17489
|
481 Electric reference mode will cycle through this list of functions."
|
|
|
482 :type '(repeat sexp)
|
|
|
483 :group 'supercite)
|
|
62315
|
484 (put 'sc-rewrite-header-list 'risky-local-variable t)
|
|
4850
|
485
|
|
17489
|
486 (defcustom sc-titlecue-regexp "\\s +-+\\s +"
|
|
92543
|
487 "Regular expression describing the separator between names and titles.
|
|
17489
|
488 Set to nil to treat entire field as a name."
|
|
|
489 :type '(choice (const :tag "entire field as name" nil)
|
|
|
490 regexp)
|
|
|
491 :group 'supercite-attr)
|
|
4850
|
492
|
|
17489
|
493 (defcustom sc-use-only-preference-p nil
|
|
92543
|
494 "Controls what happens when the preferred attribution cannot be found.
|
|
4850
|
495 If non-nil, then `sc-default-attribution' will be used. If nil, then
|
|
|
496 some secondary scheme will be employed to find a suitable attribution
|
|
17489
|
497 string."
|
|
|
498 :type 'boolean
|
|
|
499 :group 'supercite-attr)
|
|
4850
|
500
|
|
92543
|
501 (defcustom sc-mode-map-prefix "\C-c\C-p"
|
|
|
502 "Key binding to install Supercite keymap."
|
|
|
503 :type 'string
|
|
|
504 :group 'supercite)
|
|
|
505
|
|
4850
|
506 ;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
|
|
|
507 ;; end user configuration variables
|
|
|
508
|
|
86532
|
509 (define-obsolete-variable-alias 'sc-version 'emacs-version "23.1")
|
|
4850
|
510
|
|
|
511 (defvar sc-mail-info nil
|
|
|
512 "Alist of mail header information gleaned from reply buffer.")
|
|
|
513 (defvar sc-attributions nil
|
|
|
514 "Alist of attributions for use when citing.")
|
|
|
515
|
|
|
516 (defvar sc-tmp-nested-regexp nil
|
|
51174
|
517 "Temporary regexp describing nested citations.")
|
|
4850
|
518 (defvar sc-tmp-nonnested-regexp nil
|
|
|
519 "Temporary regexp describing non-nested citations.")
|
|
|
520 (defvar sc-tmp-dumb-regexp nil
|
|
|
521 "Temp regexp describing non-nested citation cited with a nesting citer.")
|
|
|
522
|
|
|
523 (make-variable-buffer-local 'sc-mail-info)
|
|
|
524 (make-variable-buffer-local 'sc-attributions)
|
|
|
525
|
|
|
526
|
|
|
527 ;; ======================================================================
|
|
|
528 ;; supercite keymaps
|
|
|
529
|
|
51174
|
530 (defvar sc-T-keymap
|
|
|
531 (let ((map (make-sparse-keymap)))
|
|
|
532 (define-key map "a" 'sc-S-preferred-attribution-list)
|
|
|
533 (define-key map "b" 'sc-T-mail-nuke-blank-lines)
|
|
|
534 (define-key map "c" 'sc-T-confirm-always)
|
|
|
535 (define-key map "d" 'sc-T-downcase)
|
|
|
536 (define-key map "e" 'sc-T-electric-references)
|
|
|
537 (define-key map "f" 'sc-T-auto-fill-region)
|
|
|
538 (define-key map "h" 'sc-T-describe)
|
|
|
539 (define-key map "l" 'sc-S-cite-region-limit)
|
|
|
540 (define-key map "n" 'sc-S-mail-nuke-mail-headers)
|
|
|
541 (define-key map "N" 'sc-S-mail-header-nuke-list)
|
|
|
542 (define-key map "o" 'sc-T-electric-circular)
|
|
|
543 (define-key map "p" 'sc-S-preferred-header-style)
|
|
|
544 (define-key map "s" 'sc-T-nested-citation)
|
|
|
545 (define-key map "u" 'sc-T-use-only-preferences)
|
|
|
546 (define-key map "w" 'sc-T-fixup-whitespace)
|
|
|
547 (define-key map "?" 'sc-T-describe)
|
|
|
548 map)
|
|
4850
|
549 "Keymap for sub-keymap of setting and toggling functions.")
|
|
|
550
|
|
51174
|
551 (defvar sc-mode-map
|
|
|
552 (let ((map (make-sparse-keymap)))
|
|
|
553 (define-key map "c" 'sc-cite-region)
|
|
|
554 (define-key map "f" 'sc-mail-field-query)
|
|
|
555 (define-key map "g" 'sc-mail-process-headers)
|
|
|
556 (define-key map "h" 'sc-describe)
|
|
|
557 (define-key map "i" 'sc-insert-citation)
|
|
|
558 (define-key map "o" 'sc-open-line)
|
|
|
559 (define-key map "r" 'sc-recite-region)
|
|
|
560 (define-key map "\C-p" 'sc-raw-mode-toggle)
|
|
|
561 (define-key map "u" 'sc-uncite-region)
|
|
|
562 (define-key map "v" 'sc-version)
|
|
|
563 (define-key map "w" 'sc-insert-reference)
|
|
|
564 (define-key map "\C-t" sc-T-keymap)
|
|
|
565 (define-key map "\C-b" 'sc-submit-bug-report)
|
|
|
566 (define-key map "?" 'sc-describe)
|
|
|
567 map)
|
|
4850
|
568 "Keymap for Supercite quasi-mode.")
|
|
49598
|
569
|
|
51174
|
570 (defvar sc-electric-mode-map
|
|
|
571 (let ((map (make-sparse-keymap)))
|
|
|
572 (define-key map "p" 'sc-eref-prev)
|
|
|
573 (define-key map "n" 'sc-eref-next)
|
|
|
574 (define-key map "s" 'sc-eref-setn)
|
|
|
575 (define-key map "j" 'sc-eref-jump)
|
|
|
576 (define-key map "x" 'sc-eref-abort)
|
|
|
577 (define-key map "q" 'sc-eref-abort)
|
|
|
578 (define-key map "\r" 'sc-eref-exit)
|
|
|
579 (define-key map "\n" 'sc-eref-exit)
|
|
|
580 (define-key map "g" 'sc-eref-goto)
|
|
|
581 (define-key map "?" 'describe-mode)
|
|
|
582 (define-key map "\C-h" 'describe-mode)
|
|
|
583 (define-key map [f1] 'describe-mode)
|
|
|
584 (define-key map [help] 'describe-mode)
|
|
|
585 map)
|
|
4850
|
586 "Keymap for `sc-electric-mode' electric references mode.")
|
|
51174
|
587
|
|
4850
|
588
|
|
51174
|
589 (defvar sc-minibuffer-local-completion-map
|
|
|
590 (let ((map (copy-keymap minibuffer-local-completion-map)))
|
|
|
591 (define-key map "\C-t" 'sc-toggle-fn)
|
|
|
592 (define-key map " " 'self-insert-command)
|
|
|
593 map)
|
|
4850
|
594 "Keymap for minibuffer confirmation of attribution strings.")
|
|
|
595
|
|
51174
|
596 (defvar sc-minibuffer-local-map
|
|
|
597 (let ((map (copy-keymap minibuffer-local-map)))
|
|
|
598 (define-key map "\C-t" 'sc-toggle-fn)
|
|
|
599 map)
|
|
4850
|
600 "Keymap for minibuffer confirmation of attribution strings.")
|
|
|
601
|
|
|
602
|
|
|
603 ;; ======================================================================
|
|
|
604 ;; utility functions
|
|
|
605
|
|
|
606 (defun sc-ask (alist)
|
|
|
607 "Ask a question in the minibuffer requiring a single character answer.
|
|
|
608 This function is kind of an extension of `y-or-n-p' where a single
|
|
|
609 letter is used to answer a question. Question is formed from ALIST
|
|
|
610 which has members of the form: (WORD . LETTER). WORD is the long
|
|
|
611 word form, while LETTER is the letter for selecting that answer. The
|
|
|
612 selected letter is returned, or nil if the question was not answered.
|
|
|
613 Note that WORD is a string and LETTER is a character. All LETTERs in
|
|
|
614 the list should be unique."
|
|
|
615 (let* ((prompt (concat
|
|
92814
|
616 (mapconcat (lambda (elt) (car elt)) alist ", ")
|
|
4850
|
617 "? ("
|
|
|
618 (mapconcat
|
|
92814
|
619 (lambda (elt) (char-to-string (cdr elt))) alist "/")
|
|
4850
|
620 ") "))
|
|
|
621 (p prompt)
|
|
|
622 (event
|
|
51174
|
623 (if (fboundp 'allocate-event)
|
|
4850
|
624 (allocate-event)
|
|
|
625 nil)))
|
|
|
626 (while (stringp p)
|
|
|
627 (if (let ((cursor-in-echo-area t)
|
|
|
628 (inhibit-quit t))
|
|
|
629 (message "%s" p)
|
|
51174
|
630 (setq event (read-event))
|
|
4850
|
631 (prog1 quit-flag (setq quit-flag nil)))
|
|
|
632 (progn
|
|
|
633 (message "%s%s" p (single-key-description event))
|
|
64832
|
634 (if (fboundp 'deallocate-event)
|
|
|
635 (deallocate-event event))
|
|
4850
|
636 (setq quit-flag nil)
|
|
|
637 (signal 'quit '())))
|
|
|
638 (let ((char
|
|
51174
|
639 (if (featurep 'xemacs)
|
|
4850
|
640 (let* ((key (and (key-press-event-p event) (event-key event)))
|
|
|
641 (char (and key (event-to-character event))))
|
|
|
642 char)
|
|
|
643 event))
|
|
|
644 elt)
|
|
|
645 (if char (setq char (downcase char)))
|
|
|
646 (cond
|
|
|
647 ((setq elt (rassq char alist))
|
|
|
648 (message "%s%s" p (car elt))
|
|
|
649 (setq p (cdr elt)))
|
|
64832
|
650 ((if (fboundp 'button-release-event-p)
|
|
|
651 (button-release-event-p event)) ; ignore them
|
|
4850
|
652 nil)
|
|
|
653 (t
|
|
|
654 (message "%s%s" p (single-key-description event))
|
|
51174
|
655 (if (featurep 'xemacs)
|
|
4850
|
656 (ding nil 'y-or-n-p)
|
|
|
657 (ding))
|
|
|
658 (discard-input)
|
|
|
659 (if (eq p prompt)
|
|
|
660 (setq p (concat "Try again. " prompt)))))))
|
|
64832
|
661 (if (fboundp 'deallocate-event)
|
|
|
662 (deallocate-event event))
|
|
4850
|
663 p))
|
|
|
664
|
|
|
665 (defun sc-scan-info-alist (alist)
|
|
|
666 "Find a match in the info alist that matches a regexp in ALIST."
|
|
|
667 (let ((sc-mumble "")
|
|
|
668 rtnvalue)
|
|
|
669 (while alist
|
|
|
670 (let* ((elem (car alist))
|
|
|
671 (infokey (car elem))
|
|
|
672 (infoval (sc-mail-field infokey))
|
|
92814
|
673 (mlist (cadr elem)))
|
|
4850
|
674 (while mlist
|
|
|
675 (let* ((ml-elem (car mlist))
|
|
|
676 (regexp (car ml-elem))
|
|
|
677 (thing (cdr ml-elem)))
|
|
|
678 (if (string-match regexp infoval)
|
|
|
679 ;; we found a match, time to return
|
|
24613
|
680 (setq rtnvalue thing
|
|
4850
|
681 mlist nil
|
|
|
682 alist nil)
|
|
|
683 ;; else we didn't find a match
|
|
92814
|
684 (setq mlist (cdr mlist))))) ;end of mlist loop
|
|
|
685 (setq alist (cdr alist)))) ;end of alist loop
|
|
4850
|
686 rtnvalue))
|
|
|
687
|
|
|
688
|
|
|
689 ;; ======================================================================
|
|
|
690 ;; extract mail field information from headers in reply buffer
|
|
|
691
|
|
|
692 ;; holder variables for bc happiness
|
|
|
693 (defvar sc-mail-headers-start nil
|
|
|
694 "Start of header fields.")
|
|
|
695 (defvar sc-mail-headers-end nil
|
|
|
696 "End of header fields.")
|
|
|
697 (defvar sc-mail-field-history nil
|
|
|
698 "For minibuffer completion on mail field queries.")
|
|
|
699 (defvar sc-mail-field-modification-history nil
|
|
|
700 "For minibuffer completion on mail field modifications.")
|
|
|
701 (defvar sc-mail-glom-frame
|
|
|
702 '((begin (setq sc-mail-headers-start (point)))
|
102154
3da2fdefd254
(sc-mail-glom-frame): Handle a "From " line at the start of the headers.
Glenn Morris <rgm@gnu.org>
diff
changeset
|
703 ("^From " (sc-mail-check-from) nil nil)
|
|
4850
|
704 ("^x-attribution:[ \t]+.*$" (sc-mail-fetch-field t) nil t)
|
|
|
705 ("^\\S +:.*$" (sc-mail-fetch-field) nil t)
|
|
|
706 ("^$" (list 'abort '(step . 0)))
|
|
|
707 ("^[ \t]+" (sc-mail-append-field))
|
|
|
708 (sc-mail-warn-if-non-rfc822-p (sc-mail-error-in-mail-field))
|
|
|
709 (end (setq sc-mail-headers-end (point))))
|
|
|
710 "Regi frame for glomming mail header information.")
|
|
63056
|
711 (put 'sc-mail-glom-frame 'risky-local-variable t)
|
|
4850
|
712
|
|
51174
|
713 (defvar curline) ; dynamic bondage
|
|
28437
|
714
|
|
4850
|
715 ;; regi functions
|
102154
3da2fdefd254
(sc-mail-glom-frame): Handle a "From " line at the start of the headers.
Glenn Morris <rgm@gnu.org>
diff
changeset
|
716
|
3da2fdefd254
(sc-mail-glom-frame): Handle a "From " line at the start of the headers.
Glenn Morris <rgm@gnu.org>
diff
changeset
|
717 ;; http://lists.gnu.org/archive/html/emacs-devel/2009-02/msg00691.html
|
3da2fdefd254
(sc-mail-glom-frame): Handle a "From " line at the start of the headers.
Glenn Morris <rgm@gnu.org>
diff
changeset
|
718 ;; When rmail replies to a message with full headers visible, the "From "
|
3da2fdefd254
(sc-mail-glom-frame): Handle a "From " line at the start of the headers.
Glenn Morris <rgm@gnu.org>
diff
changeset
|
719 ;; line can be included.
|
3da2fdefd254
(sc-mail-glom-frame): Handle a "From " line at the start of the headers.
Glenn Morris <rgm@gnu.org>
diff
changeset
|
720 (defun sc-mail-check-from ()
|
3da2fdefd254
(sc-mail-glom-frame): Handle a "From " line at the start of the headers.
Glenn Morris <rgm@gnu.org>
diff
changeset
|
721 "Deal with a \"From \" line in the header.
|
3da2fdefd254
(sc-mail-glom-frame): Handle a "From " line at the start of the headers.
Glenn Morris <rgm@gnu.org>
diff
changeset
|
722 Such a line should only occur at the very start of the headers."
|
3da2fdefd254
(sc-mail-glom-frame): Handle a "From " line at the start of the headers.
Glenn Morris <rgm@gnu.org>
diff
changeset
|
723 (and sc-mail-warn-if-non-rfc822-p
|
|
102175
|
724 (/= (point) sc-mail-headers-start)
|
102154
3da2fdefd254
(sc-mail-glom-frame): Handle a "From " line at the start of the headers.
Glenn Morris <rgm@gnu.org>
diff
changeset
|
725 (sc-mail-error-in-mail-field)))
|
3da2fdefd254
(sc-mail-glom-frame): Handle a "From " line at the start of the headers.
Glenn Morris <rgm@gnu.org>
diff
changeset
|
726
|
|
4850
|
727 (defun sc-mail-fetch-field (&optional attribs-p)
|
|
|
728 "Insert a key and value into `sc-mail-info' alist.
|
|
|
729 If optional ATTRIBS-P is non-nil, the key/value pair is placed in
|
|
|
730 `sc-attributions' too."
|
|
|
731 (if (string-match "^\\(\\S *\\)\\s *:\\s +\\(.*\\)$" curline)
|
|
51174
|
732 (let* ((key (downcase (match-string-no-properties 1 curline)))
|
|
|
733 (val (match-string-no-properties 2 curline))
|
|
4850
|
734 (keyval (cons key val)))
|
|
51174
|
735 (push keyval sc-mail-info)
|
|
4850
|
736 (if attribs-p
|
|
51174
|
737 (push keyval sc-attributions))))
|
|
4850
|
738 nil)
|
|
|
739
|
|
|
740 (defun sc-mail-append-field ()
|
|
|
741 "Append a continuation line onto the last fetched mail field's info."
|
|
|
742 (let ((keyval (car sc-mail-info)))
|
|
|
743 (if (and keyval (string-match "^\\s *\\(.*\\)$" curline))
|
11556
a83ee7a1e0fd
Made sc-string-text to strip of text properties of buffer text, so string
Simon Marshall <simon@gnu.org>
diff
changeset
|
744 (setcdr keyval (concat (cdr keyval) " "
|
|
51174
|
745 (match-string-no-properties 1 curline)))))
|
|
4850
|
746 nil)
|
|
|
747
|
|
|
748 (defun sc-mail-error-in-mail-field ()
|
|
|
749 "Issue warning that mail headers don't conform to RFC 822."
|
|
|
750 (let* ((len (min (length curline) 10))
|
|
|
751 (ellipsis (if (< len (length curline)) "..." ""))
|
|
|
752 (msg "Mail header \"%s%s\" doesn't conform to RFC 822. skipping..."))
|
|
|
753 (message msg (substring curline 0 len) ellipsis))
|
|
|
754 (beep)
|
|
|
755 (sit-for 2)
|
|
|
756 nil)
|
|
|
757
|
|
|
758 ;; mail header nuking
|
|
|
759 (defvar sc-mail-last-header-nuked-p nil
|
|
|
760 "True if the last header was nuked.")
|
|
|
761
|
|
|
762 (defun sc-mail-nuke-line ()
|
|
|
763 "Nuke the current mail header line."
|
|
51174
|
764 (delete-region (line-beginning-position) (line-beginning-position 2))
|
|
4850
|
765 '((step . -1)))
|
|
|
766
|
|
|
767 (defun sc-mail-nuke-header-line ()
|
|
|
768 "Delete current-line and set up for possible continuation."
|
|
|
769 (setq sc-mail-last-header-nuked-p t)
|
|
|
770 (sc-mail-nuke-line))
|
|
|
771
|
|
|
772 (defun sc-mail-nuke-continuation-line ()
|
|
|
773 "Delete a continuation line if the last header line was deleted."
|
|
|
774 (if sc-mail-last-header-nuked-p
|
|
|
775 (sc-mail-nuke-line)))
|
|
|
776
|
|
|
777 (defun sc-mail-cleanup-blank-lines ()
|
|
|
778 "Leave some blank lines after original mail headers are nuked.
|
|
|
779 The number of lines left is specified by `sc-blank-lines-after-headers'."
|
|
|
780 (if sc-blank-lines-after-headers
|
|
|
781 (save-restriction
|
|
|
782 (widen)
|
|
|
783 (skip-chars-backward " \t\n")
|
|
|
784 (forward-line 1)
|
|
|
785 (delete-blank-lines)
|
|
|
786 (beginning-of-line)
|
|
|
787 (if (looking-at "[ \t]*$")
|
|
51174
|
788 (delete-region (line-beginning-position)
|
|
|
789 (line-beginning-position 2)))
|
|
4850
|
790 (insert-char ?\n sc-blank-lines-after-headers)))
|
|
|
791 nil)
|
|
|
792
|
|
|
793 (defun sc-mail-build-nuke-frame ()
|
|
|
794 "Build the regiframe for nuking mail headers."
|
|
|
795 (let (every-func entry-func nonentry-func)
|
|
|
796 (cond
|
|
|
797 ((eq sc-nuke-mail-headers 'all)
|
|
|
798 (setq every-func '(progn (forward-line -1) (sc-mail-nuke-line))))
|
|
|
799 ((eq sc-nuke-mail-headers 'specified)
|
|
|
800 (setq entry-func '(sc-mail-nuke-header-line)
|
|
|
801 nonentry-func '(setq sc-mail-last-header-nuked-p nil)))
|
|
|
802 ((eq sc-nuke-mail-headers 'keep)
|
|
|
803 (setq entry-func '(setq sc-mail-last-header-nuked-p nil)
|
|
|
804 nonentry-func '(sc-mail-nuke-header-line)))
|
|
|
805 ;; we never get far enough to interpret a frame if s-n-m-h == 'none
|
|
|
806 ((eq sc-nuke-mail-headers 'none))
|
|
60916
|
807 (t (error "Invalid value for sc-nuke-mail-headers: %s"
|
|
92814
|
808 sc-nuke-mail-headers))) ; end-cond
|
|
4850
|
809 (append
|
|
|
810 (and entry-func
|
|
|
811 (regi-mapcar sc-nuke-mail-header-list entry-func nil t))
|
|
|
812 (and nonentry-func (list (list "^\\S +:.*$" nonentry-func)))
|
|
|
813 (and (not every-func)
|
|
|
814 '(("^[ \t]+" (sc-mail-nuke-continuation-line))))
|
|
|
815 '((begin (setq sc-mail-last-header-zapped-p nil)))
|
|
|
816 '((end (sc-mail-cleanup-blank-lines)))
|
|
92814
|
817 (and every-func (list (list 'every every-func))))))
|
|
4850
|
818
|
|
|
819 ;; mail processing and zapping. this is the top level entry defun to
|
|
|
820 ;; all header processing.
|
|
|
821 (defun sc-mail-process-headers (start end)
|
|
|
822 "Process original mail message's mail headers.
|
|
|
823 After processing, mail headers may be nuked. Header information is
|
|
|
824 stored in `sc-mail-info', and any old information is lost unless an
|
|
|
825 error occurs."
|
|
|
826 (interactive "r")
|
|
|
827 (let ((info (copy-alist sc-mail-info))
|
|
|
828 (attribs (copy-alist sc-attributions)))
|
|
|
829 (setq sc-mail-info nil
|
|
|
830 sc-attributions nil)
|
|
|
831 (regi-interpret sc-mail-glom-frame start end)
|
|
|
832 (if (null sc-mail-info)
|
|
|
833 (progn
|
|
|
834 (message "No mail headers found! Restoring old information.")
|
|
|
835 (setq sc-mail-info info
|
|
|
836 sc-attributions attribs))
|
|
|
837 (regi-interpret (sc-mail-build-nuke-frame)
|
|
92814
|
838 sc-mail-headers-start sc-mail-headers-end))))
|
|
4850
|
839
|
|
|
840
|
|
|
841 ;; let the user change mail field information
|
|
|
842 (defun sc-mail-field (field)
|
|
|
843 "Return the mail header field value associated with FIELD.
|
|
|
844 If there was no mail header with FIELD as its key, return the value of
|
|
|
845 `sc-mumble'. FIELD is case insensitive."
|
|
61044
|
846 (or (cdr (assoc-string field sc-mail-info 'case-fold)) sc-mumble))
|
|
4850
|
847
|
|
|
848 (defun sc-mail-field-query (arg)
|
|
|
849 "View the value of a mail field.
|
|
|
850 With `\\[universal-argument]', prompts for action on mail field.
|
|
|
851 Action can be one of: View, Modify, Add, or Delete."
|
|
|
852 (interactive "P")
|
|
|
853 (let* ((alist '(("view" . ?v) ("modify" . ?m) ("add" . ?a) ("delete" . ?d)))
|
|
|
854 (action (if (not arg) ?v (sc-ask alist)))
|
|
|
855 key)
|
|
|
856 (if (not action)
|
|
|
857 ()
|
|
51174
|
858 (setq key (completing-read
|
|
4850
|
859 (concat (car (rassq action alist))
|
|
|
860 " information key: ")
|
|
|
861 sc-mail-info nil
|
|
|
862 (if (eq action ?a) nil 'noexit)
|
|
|
863 nil 'sc-mail-field-history))
|
|
|
864 (cond
|
|
|
865 ((eq action ?v)
|
|
|
866 (message "%s: %s" key (cdr (assoc key sc-mail-info))))
|
|
|
867 ((eq action ?d)
|
|
|
868 (setq sc-mail-info (delq (assoc key sc-mail-info) sc-mail-info)))
|
|
|
869 ((eq action ?m)
|
|
|
870 (let ((keyval (assoc key sc-mail-info)))
|
|
|
871 ;; first put initial value onto list if not already there
|
|
51174
|
872 (if (not (member (cdr keyval)
|
|
|
873 sc-mail-field-modification-history))
|
|
4850
|
874 (setq sc-mail-field-modification-history
|
|
|
875 (cons (cdr keyval) sc-mail-field-modification-history)))
|
|
51174
|
876 (setcdr keyval (read-string
|
|
4850
|
877 (concat key ": ") (cdr keyval)
|
|
|
878 'sc-mail-field-modification-history))))
|
|
|
879 ((eq action ?a)
|
|
92814
|
880 (push (cons key (read-string (concat key ": "))) sc-mail-info))))))
|
|
4850
|
881
|
|
|
882
|
|
|
883 ;; ======================================================================
|
|
|
884 ;; attributions
|
|
|
885
|
|
|
886 (defvar sc-attribution-confirmation-history nil
|
|
|
887 "History for confirmation of attribution strings.")
|
|
|
888 (defvar sc-citation-confirmation-history nil
|
|
|
889 "History for confirmation of attribution prefixes.")
|
|
|
890
|
|
|
891 (defun sc-attribs-%@-addresses (from &optional delim)
|
|
|
892 "Extract the author's email terminus from email address FROM.
|
|
|
893 Match addresses of the style ``name%[stuff].'' when called with DELIM
|
|
|
894 of \"%\" and addresses of the style ``[stuff]name@[stuff]'' when
|
|
|
895 called with DELIM \"@\". If DELIM is nil or not provided, matches
|
|
|
896 addresses of the style ``name''."
|
|
51174
|
897 (and (string-match (concat "[-[:alnum:]_.]+" delim) from 0)
|
|
4850
|
898 (substring from
|
|
|
899 (match-beginning 0)
|
|
|
900 (- (match-end 0) (if (null delim) 0 1)))))
|
|
|
901
|
|
|
902 (defun sc-attribs-!-addresses (from)
|
|
|
903 "Extract the author's email terminus from email address FROM.
|
|
|
904 Match addresses of the style ``[stuff]![stuff]...!name[stuff].''"
|
|
|
905 (let ((eos (length from))
|
|
51174
|
906 (mstart (string-match "![-[:alnum:]_.]+\\([^-![:alnum:]_.]\\|$\\)"
|
|
4850
|
907 from 0))
|
|
|
908 (mend (match-end 0)))
|
|
|
909 (and mstart
|
|
92814
|
910 (substring from (1+ mstart) (- mend (if (= mend eos) 0 1))))))
|
|
4850
|
911
|
|
|
912 (defun sc-attribs-<>-addresses (from)
|
|
|
913 "Extract the author's email terminus from email address FROM.
|
|
|
914 Match addresses of the style ``<name[stuff]>.''"
|
|
|
915 (and (string-match "<\\(.*\\)>" from)
|
|
51174
|
916 (match-string 1 from)))
|
|
4850
|
917
|
|
|
918 (defun sc-get-address (from author)
|
|
|
919 "Get the full email address path from FROM.
|
|
|
920 AUTHOR is the author's name (which is removed from the address)."
|
|
|
921 (let ((eos (length from)))
|
|
61044
|
922 (if (string-match (concat "\\`\"?" (regexp-quote author)
|
|
|
923 "\"?\\s +") from 0)
|
|
4850
|
924 (let ((address (substring from (match-end 0) eos)))
|
|
|
925 (if (and (= (aref address 0) ?<)
|
|
|
926 (= (aref address (1- (length address))) ?>))
|
|
|
927 (substring address 1 (1- (length address)))
|
|
|
928 address))
|
|
28437
|
929 (if (string-match "[-[:alnum:]!@%._]+" from 0)
|
|
51174
|
930 (match-string 0 from)
|
|
92814
|
931 ""))))
|
|
4850
|
932
|
|
|
933 (defun sc-attribs-emailname (from)
|
|
|
934 "Get the email terminus name from FROM."
|
|
|
935 (or
|
|
|
936 (sc-attribs-%@-addresses from "%")
|
|
|
937 (sc-attribs-%@-addresses from "@")
|
|
|
938 (sc-attribs-!-addresses from)
|
|
|
939 (sc-attribs-<>-addresses from)
|
|
|
940 (sc-attribs-%@-addresses from)
|
|
|
941 (substring from 0 10)))
|
|
|
942
|
|
|
943 (defun sc-name-substring (string start end extend)
|
|
|
944 "Extract the specified substring of STRING from START to END.
|
|
|
945 EXTEND is the number of characters on each side to extend the
|
|
|
946 substring."
|
|
|
947 (and start
|
|
|
948 (let ((sos (+ start extend))
|
|
|
949 (eos (- end extend)))
|
|
|
950 (substring string sos
|
|
92814
|
951 (or (string-match sc-titlecue-regexp string sos) eos)))))
|
|
4850
|
952
|
|
|
953 (defun sc-attribs-extract-namestring (from)
|
|
|
954 "Extract the name string from FROM.
|
|
|
955 This should be the author's full name minus an optional title."
|
|
51174
|
956 ;; FIXME: we probably should use mail-extract-address-components.
|
|
4850
|
957 (let ((namestring
|
|
|
958 (or
|
|
12859
|
959 ;; If there is a <...> in the name,
|
|
|
960 ;; treat everything before that as the full name.
|
|
|
961 ;; Even if it contains parens, use the whole thing.
|
|
13813
|
962 ;; On the other hand, we do look for quotes in the usual way.
|
|
12859
|
963 (and (string-match " *<.*>" from 0)
|
|
13813
|
964 (let ((before-angles
|
|
|
965 (sc-name-substring from 0 (match-beginning 0) 0)))
|
|
|
966 (if (string-match "\".*\"" before-angles 0)
|
|
|
967 (sc-name-substring
|
|
|
968 before-angles (match-beginning 0) (match-end 0) 1)
|
|
|
969 before-angles)))
|
|
4850
|
970 (sc-name-substring
|
|
|
971 from (string-match "(.*)" from 0) (match-end 0) 1)
|
|
|
972 (sc-name-substring
|
|
|
973 from (string-match "\".*\"" from 0) (match-end 0) 1)
|
|
|
974 (sc-name-substring
|
|
28437
|
975 from (string-match "\\([-.[:alnum:]_]+\\s +\\)+<" from 0)
|
|
4850
|
976 (match-end 1) 0)
|
|
|
977 (sc-attribs-emailname from))))
|
|
|
978 ;; strip off any leading or trailing whitespace
|
|
|
979 (if namestring
|
|
|
980 (let ((bos 0)
|
|
|
981 (eos (1- (length namestring))))
|
|
|
982 (while (and (<= bos eos)
|
|
|
983 (memq (aref namestring bos) '(32 ?\t)))
|
|
|
984 (setq bos (1+ bos)))
|
|
|
985 (while (and (> eos bos)
|
|
|
986 (memq (aref namestring eos) '(32 ?\t)))
|
|
|
987 (setq eos (1- eos)))
|
|
|
988 (substring namestring bos (1+ eos))))))
|
|
|
989
|
|
|
990 (defun sc-attribs-chop-namestring (namestring)
|
|
|
991 "Convert NAMESTRING to a list of names.
|
|
51174
|
992 example: (sc-attribs-chop-namestring \"John Xavier Doe\")
|
|
4850
|
993 => (\"John\" \"Xavier\" \"Doe\")"
|
|
|
994 (if (string-match "\\([ \t]*\\)\\([^ \t._]+\\)\\([ \t]*\\)" namestring)
|
|
51174
|
995 (cons (match-string 2 namestring)
|
|
92814
|
996 (sc-attribs-chop-namestring (substring namestring (match-end 3))))))
|
|
4850
|
997
|
|
|
998 (defun sc-attribs-strip-initials (namelist)
|
|
|
999 "Extract the author's initials from the NAMELIST."
|
|
|
1000 (mapconcat
|
|
92814
|
1001 (lambda (name)
|
|
|
1002 (if (< 0 (length name))
|
|
|
1003 (substring name 0 1)))
|
|
4850
|
1004 namelist ""))
|
|
|
1005
|
|
|
1006 (defun sc-guess-attribution (&optional string)
|
|
|
1007 "Guess attribution string on current line.
|
|
|
1008 If attribution cannot be guessed, nil is returned. Optional STRING if
|
|
|
1009 supplied, is used instead of the line point is on in the current buffer."
|
|
|
1010 (let ((start 0)
|
|
51174
|
1011 (string (or string (buffer-substring (line-beginning-position)
|
|
|
1012 (line-end-position))))
|
|
4850
|
1013 attribution)
|
|
|
1014 (and
|
|
|
1015 (= start (or (string-match sc-citation-leader-regexp string start) -1))
|
|
|
1016 (setq start (match-end 0))
|
|
|
1017 (= start (or (string-match sc-citation-root-regexp string start) 1))
|
|
51174
|
1018 (setq attribution (match-string 0 string)
|
|
4850
|
1019 start (match-end 0))
|
|
|
1020 (= start (or (string-match sc-citation-delimiter-regexp string start) -1))
|
|
|
1021 (setq start (match-end 0))
|
|
|
1022 (= start (or (string-match sc-citation-separator-regexp string start) -1))
|
|
|
1023 attribution)))
|
|
|
1024
|
|
|
1025 (defun sc-attribs-filter-namelist (namelist)
|
|
|
1026 "Filter out noise in NAMELIST according to `sc-name-filter-alist'."
|
|
|
1027 (let ((elements (length namelist))
|
|
|
1028 (position -1)
|
|
|
1029 keepers filtered-list)
|
|
84957
|
1030 (mapc
|
|
92814
|
1031 (lambda (name)
|
|
|
1032 (setq position (1+ position))
|
|
|
1033 (let ((keep-p t))
|
|
|
1034 (mapc
|
|
|
1035 (function
|
|
|
1036 (lambda (filter)
|
|
|
1037 (let ((regexp (car filter))
|
|
|
1038 (pos (cdr filter)))
|
|
|
1039 (if (and (string-match regexp name)
|
|
|
1040 (or (and (numberp pos)
|
|
|
1041 (= pos position))
|
|
|
1042 (and (eq pos 'last)
|
|
|
1043 (= position (1- elements)))
|
|
|
1044 (eq pos 'any)))
|
|
|
1045 (setq keep-p nil)))))
|
|
|
1046 sc-name-filter-alist)
|
|
|
1047 (if keep-p
|
|
|
1048 (setq keepers (cons position keepers)))))
|
|
4850
|
1049 namelist)
|
|
84957
|
1050 (mapc
|
|
92814
|
1051 (lambda (position)
|
|
|
1052 (setq filtered-list (cons (nth position namelist) filtered-list)))
|
|
4850
|
1053 keepers)
|
|
|
1054 filtered-list))
|
|
|
1055
|
|
|
1056 (defun sc-attribs-chop-address (from)
|
|
|
1057 "Extract attribution information from FROM.
|
|
|
1058 This populates the `sc-attributions' with the list of possible attributions."
|
|
|
1059 (if (and (stringp from)
|
|
|
1060 (< 0 (length from)))
|
|
49598
|
1061 (let* ((sc-mumble "")
|
|
4850
|
1062 (namestring (sc-attribs-extract-namestring from))
|
|
|
1063 (namelist (sc-attribs-filter-namelist
|
|
|
1064 (sc-attribs-chop-namestring namestring)))
|
|
|
1065 (revnames (reverse (cdr namelist)))
|
|
|
1066 (firstname (car namelist))
|
|
|
1067 (midnames (reverse (cdr revnames)))
|
|
|
1068 (lastname (car revnames))
|
|
|
1069 (initials (sc-attribs-strip-initials namelist))
|
|
|
1070 (emailname (sc-attribs-emailname from))
|
|
|
1071 (n 1)
|
|
|
1072 author middlenames)
|
|
49598
|
1073
|
|
4850
|
1074 ;; put basic information
|
|
|
1075 (setq
|
|
|
1076 ;; put middle names and build sc-author entry
|
|
|
1077 middlenames (mapconcat
|
|
92814
|
1078 (lambda (midname)
|
|
|
1079 (let ((key-attribs (format "middlename-%d" n))
|
|
|
1080 (key-mail (format "sc-middlename-%d" n)))
|
|
|
1081 (push (cons key-attribs midname) sc-attributions)
|
|
|
1082 (push (cons key-mail midname) sc-mail-info)
|
|
|
1083 (setq n (1+ n))
|
|
|
1084 midname))
|
|
4850
|
1085 midnames " ")
|
|
|
1086
|
|
|
1087 author (concat firstname " " middlenames (and midnames " ") lastname)
|
|
|
1088
|
|
|
1089 sc-attributions (append
|
|
|
1090 (list
|
|
|
1091 (cons "firstname" firstname)
|
|
|
1092 (cons "lastname" lastname)
|
|
|
1093 (cons "emailname" emailname)
|
|
|
1094 (cons "initials" initials))
|
|
|
1095 sc-attributions)
|
|
|
1096 sc-mail-info (append
|
|
|
1097 (list
|
|
|
1098 (cons "sc-firstname" firstname)
|
|
|
1099 (cons "sc-middlenames" middlenames)
|
|
|
1100 (cons "sc-lastname" lastname)
|
|
|
1101 (cons "sc-emailname" emailname)
|
|
|
1102 (cons "sc-initials" initials)
|
|
|
1103 (cons "sc-author" author)
|
|
|
1104 (cons "sc-from-address" (sc-get-address
|
|
|
1105 (sc-mail-field "from")
|
|
|
1106 namestring))
|
|
|
1107 (cons "sc-reply-address" (sc-get-address
|
|
|
1108 (sc-mail-field "reply-to")
|
|
|
1109 namestring))
|
|
|
1110 (cons "sc-sender-address" (sc-get-address
|
|
|
1111 (sc-mail-field "sender")
|
|
92814
|
1112 namestring)))
|
|
|
1113 sc-mail-info)))
|
|
4850
|
1114 ;; from string is empty
|
|
51174
|
1115 (push (cons "sc-author" sc-default-author-name) sc-mail-info)))
|
|
4850
|
1116
|
|
|
1117 (defvar sc-attrib-or-cite nil
|
|
|
1118 "Used to toggle between attribution input or citation input.")
|
|
|
1119
|
|
|
1120 (defun sc-toggle-fn ()
|
|
|
1121 "Toggle between attribution selection and citation selection.
|
|
|
1122 Only used during confirmation."
|
|
|
1123 (interactive)
|
|
|
1124 (setq sc-attrib-or-cite (not sc-attrib-or-cite))
|
|
|
1125 (throw 'sc-reconfirm t))
|
|
|
1126
|
|
|
1127 (defun sc-select-attribution ()
|
|
|
1128 "Select an attribution from `sc-attributions'.
|
|
|
1129
|
|
|
1130 Variables involved in selection process include:
|
|
|
1131 `sc-preferred-attribution-list'
|
|
|
1132 `sc-use-only-preference-p'
|
|
|
1133 `sc-confirm-always-p'
|
|
|
1134 `sc-default-attribution'
|
|
|
1135 `sc-attrib-selection-list'.
|
|
|
1136
|
|
|
1137 Runs the hook `sc-attribs-preselect-hook' before selecting an
|
|
|
1138 attribution and the hook `sc-attribs-postselect-hook' after making the
|
|
|
1139 selection but before querying is performed. During
|
|
|
1140 `sc-attribs-postselect-hook' the variable `citation' is bound to the
|
|
|
1141 auto-selected citation string and the variable `attribution' is bound
|
|
|
1142 to the auto-selected attribution string."
|
|
|
1143 (run-hooks 'sc-attribs-preselect-hook)
|
|
|
1144 (let ((query-p sc-confirm-always-p)
|
|
|
1145 attribution citation
|
|
|
1146 (attriblist sc-preferred-attribution-list))
|
|
|
1147
|
|
|
1148 ;; first cruise through sc-preferred-attribution-list looking for
|
|
|
1149 ;; a match in either sc-attributions or sc-mail-info. if the
|
|
|
1150 ;; element is "sc-consult", then we have to do the alist
|
|
|
1151 ;; consultation phase
|
|
|
1152 (while attriblist
|
|
|
1153 (let* ((preferred (car attriblist)))
|
|
|
1154 (cond
|
|
|
1155 ((string= preferred "sc-consult")
|
|
|
1156 ;; we've been told to consult the attribution vs. mail
|
|
|
1157 ;; header key alist. we do this until we find a match in
|
|
|
1158 ;; the sc-attrib-selection-list. if we do not find a match,
|
|
|
1159 ;; we continue scanning attriblist
|
|
|
1160 (let ((attrib (sc-scan-info-alist sc-attrib-selection-list)))
|
|
|
1161 (cond
|
|
|
1162 ((not attrib)
|
|
|
1163 (setq attriblist (cdr attriblist)))
|
|
|
1164 ((stringp attrib)
|
|
|
1165 (setq attribution attrib
|
|
|
1166 attriblist nil))
|
|
|
1167 ((listp attrib)
|
|
62903
|
1168 (setq attribution (eval attrib))
|
|
|
1169 (if (stringp attribution)
|
|
|
1170 (setq attriblist nil)
|
|
|
1171 (setq attribution nil
|
|
|
1172 attriblist (cdr attriblist))))
|
|
4850
|
1173 (t (error "%s did not evaluate to a string or list!"
|
|
92814
|
1174 "sc-attrib-selection-list")))))
|
|
4850
|
1175 ((setq attribution (cdr (assoc preferred sc-attributions)))
|
|
|
1176 (setq attriblist nil))
|
|
|
1177 (t
|
|
92814
|
1178 (setq attriblist (cdr attriblist))))))
|
|
4850
|
1179
|
|
|
1180 ;; if preference was not found, we may use a secondary method to
|
|
|
1181 ;; find a valid attribution
|
|
|
1182 (if (and (not attribution)
|
|
|
1183 (not sc-use-only-preference-p))
|
|
|
1184 ;; secondary method tries to find a preference in this order
|
|
|
1185 ;; 1. sc-lastchoice
|
|
|
1186 ;; 2. x-attribution
|
|
|
1187 ;; 3. firstname
|
|
|
1188 ;; 4. lastname
|
|
|
1189 ;; 5. initials
|
|
|
1190 ;; 6. first non-empty attribution in alist
|
|
|
1191 (setq attribution
|
|
|
1192 (or (cdr (assoc "sc-lastchoice" sc-attributions))
|
|
|
1193 (cdr (assoc "x-attribution" sc-attributions))
|
|
|
1194 (cdr (assoc "firstname" sc-attributions))
|
|
|
1195 (cdr (assoc "lastname" sc-attributions))
|
|
|
1196 (cdr (assoc "initials" sc-attributions))
|
|
|
1197 (cdr (car sc-attributions)))))
|
|
|
1198
|
|
|
1199 ;; still couldn't find an attribution. we're now limited to using
|
|
|
1200 ;; the default attribution, but we'll force a query when this happens
|
|
|
1201 (if (not attribution)
|
|
|
1202 (setq attribution sc-default-attribution
|
|
|
1203 query-p t))
|
|
|
1204
|
|
|
1205 ;; create the attribution prefix
|
|
|
1206 (setq citation (sc-make-citation attribution))
|
|
|
1207
|
|
|
1208 ;; run the post selection hook before querying the user
|
|
|
1209 (run-hooks 'sc-attribs-postselect-hook)
|
|
|
1210
|
|
|
1211 ;; query for confirmation
|
|
|
1212 (if query-p
|
|
92814
|
1213 (let* ((query-alist (mapcar (lambda (entry) (list (cdr entry)))
|
|
4850
|
1214 sc-attributions))
|
|
|
1215 (minibuffer-local-completion-map
|
|
|
1216 sc-minibuffer-local-completion-map)
|
|
|
1217 (minibuffer-local-map sc-minibuffer-local-map)
|
|
|
1218 (initial attribution)
|
|
|
1219 (completer-disable t) ; in case completer.el is used
|
|
|
1220 choice)
|
|
|
1221 (setq sc-attrib-or-cite nil) ; nil==attribution, t==citation
|
|
|
1222 (while
|
|
|
1223 (catch 'sc-reconfirm
|
43791
2e05b93ba14a
(sc-select-attribution): Accept whatever value we get in CHOICE; there
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1224 (progn
|
2e05b93ba14a
(sc-select-attribution): Accept whatever value we get in CHOICE; there
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1225 (setq choice
|
2e05b93ba14a
(sc-select-attribution): Accept whatever value we get in CHOICE; there
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1226 (if sc-attrib-or-cite
|
|
51174
|
1227 (read-string
|
43791
2e05b93ba14a
(sc-select-attribution): Accept whatever value we get in CHOICE; there
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1228 "Enter citation prefix: "
|
2e05b93ba14a
(sc-select-attribution): Accept whatever value we get in CHOICE; there
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1229 citation
|
2e05b93ba14a
(sc-select-attribution): Accept whatever value we get in CHOICE; there
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1230 'sc-citation-confirmation-history)
|
|
51174
|
1231 (completing-read
|
43791
2e05b93ba14a
(sc-select-attribution): Accept whatever value we get in CHOICE; there
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1232 "Complete attribution name: "
|
2e05b93ba14a
(sc-select-attribution): Accept whatever value we get in CHOICE; there
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1233 query-alist nil nil
|
2e05b93ba14a
(sc-select-attribution): Accept whatever value we get in CHOICE; there
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1234 (cons initial 0)
|
|
92814
|
1235 'sc-attribution-confirmation-history)))
|
43791
2e05b93ba14a
(sc-select-attribution): Accept whatever value we get in CHOICE; there
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1236 nil)))
|
|
4850
|
1237 (if sc-attrib-or-cite
|
|
|
1238 ;; since the citation was chosen, we have to guess at
|
|
|
1239 ;; the attribution
|
|
|
1240 (setq citation choice
|
|
|
1241 attribution (or (sc-guess-attribution citation)
|
|
|
1242 citation))
|
|
49598
|
1243
|
|
4850
|
1244 (setq citation (sc-make-citation choice)
|
|
92814
|
1245 attribution choice))))
|
|
4850
|
1246
|
|
|
1247 ;; its possible that the user wants to downcase the citation and
|
|
|
1248 ;; attribution
|
|
|
1249 (if sc-downcase-p
|
|
|
1250 (setq citation (downcase citation)
|
|
|
1251 attribution (downcase attribution)))
|
|
|
1252
|
|
|
1253 ;; set up mail info alist
|
|
|
1254 (let* ((ckey "sc-citation")
|
|
|
1255 (akey "sc-attribution")
|
|
|
1256 (ckeyval (assoc ckey sc-mail-info))
|
|
|
1257 (akeyval (assoc akey sc-mail-info)))
|
|
|
1258 (if ckeyval
|
|
|
1259 (setcdr ckeyval citation)
|
|
51174
|
1260 (push (cons ckey citation) sc-mail-info))
|
|
4850
|
1261 (if akeyval
|
|
|
1262 (setcdr akeyval attribution)
|
|
51174
|
1263 (push (cons akey attribution) sc-mail-info)))
|
|
4850
|
1264
|
|
|
1265 ;; set the sc-lastchoice attribution
|
|
|
1266 (let* ((lkey "sc-lastchoice")
|
|
|
1267 (lastchoice (assoc lkey sc-attributions)))
|
|
|
1268 (if lastchoice
|
|
|
1269 (setcdr lastchoice attribution)
|
|
92814
|
1270 (push (cons lkey attribution) sc-attributions)))))
|
|
4850
|
1271
|
|
|
1272
|
|
|
1273 ;; ======================================================================
|
|
|
1274 ;; filladapt hooks for supercite 3.1. you shouldn't need anything
|
|
|
1275 ;; extra to make gin-mode understand supercited lines. Even this
|
|
|
1276 ;; stuff might not be entirely necessary...
|
|
|
1277
|
|
|
1278 (defun sc-cite-regexp (&optional root-regexp)
|
|
|
1279 "Return a regexp describing a Supercited line.
|
|
|
1280 The regexp is the concatenation of `sc-citation-leader-regexp',
|
|
|
1281 `sc-citation-root-regexp', `sc-citation-delimiter-regexp', and
|
|
|
1282 `sc-citation-separator-regexp'. If optional ROOT-REGEXP is supplied,
|
|
|
1283 use it instead of `sc-citation-root-regexp'."
|
|
|
1284 (concat sc-citation-leader-regexp
|
|
|
1285 (or root-regexp sc-citation-root-regexp)
|
|
|
1286 sc-citation-delimiter-regexp
|
|
|
1287 sc-citation-separator-regexp))
|
|
|
1288
|
|
|
1289 (defun sc-make-citation (attribution)
|
|
|
1290 "Make a non-nested citation from ATTRIBUTION."
|
|
|
1291 (concat sc-citation-leader
|
|
|
1292 attribution
|
|
|
1293 sc-citation-delimiter
|
|
|
1294 sc-citation-separator))
|
|
|
1295
|
|
63945
|
1296 (defvar filladapt-prefix-table)
|
|
|
1297
|
|
4850
|
1298 (defun sc-setup-filladapt ()
|
|
|
1299 "Setup `filladapt-prefix-table' to handle Supercited paragraphs."
|
|
|
1300 (let* ((fa-sc-elt 'filladapt-supercite-included-text)
|
|
|
1301 (elt (rassq fa-sc-elt filladapt-prefix-table)))
|
|
|
1302 (if elt (setcar elt (sc-cite-regexp))
|
|
|
1303 (message "Filladapt doesn't seem to know about Supercite.")
|
|
|
1304 (beep))))
|
|
|
1305
|
|
|
1306
|
|
|
1307 ;; ======================================================================
|
|
|
1308 ;; citing and unciting regions of text
|
|
|
1309
|
|
|
1310 (defvar sc-fill-begin 1
|
|
|
1311 "Buffer position to begin filling.")
|
|
|
1312 (defvar sc-fill-line-prefix ""
|
|
|
1313 "Fill prefix of previous line")
|
|
|
1314
|
|
|
1315 ;; filling
|
|
|
1316 (defun sc-fill-if-different (&optional prefix)
|
|
|
1317 "Fill the region bounded by `sc-fill-begin' and point.
|
|
|
1318 Only fill if optional PREFIX is different than `sc-fill-line-prefix'.
|
|
|
1319 If `sc-auto-fill-region-p' is nil, do not fill region. If PREFIX is
|
|
|
1320 not supplied, initialize fill variables. This is useful for a regi
|
|
|
1321 `begin' frame-entry."
|
|
|
1322 (if (not prefix)
|
|
|
1323 (setq sc-fill-line-prefix ""
|
|
51174
|
1324 sc-fill-begin (line-beginning-position))
|
|
4850
|
1325 (if (and sc-auto-fill-region-p
|
|
|
1326 (not (string= prefix sc-fill-line-prefix)))
|
|
|
1327 (let ((fill-prefix sc-fill-line-prefix))
|
|
|
1328 (if (not (string= fill-prefix ""))
|
|
51174
|
1329 (fill-region sc-fill-begin (line-beginning-position)))
|
|
4850
|
1330 (setq sc-fill-line-prefix prefix
|
|
92814
|
1331 sc-fill-begin (line-beginning-position)))))
|
|
4850
|
1332 nil)
|
|
|
1333
|
|
|
1334 (defun sc-cite-coerce-cited-line ()
|
|
|
1335 "Coerce a Supercited line to look like our style."
|
|
|
1336 (let* ((attribution (sc-guess-attribution))
|
|
|
1337 (regexp (sc-cite-regexp attribution))
|
|
|
1338 (prefix (sc-make-citation attribution)))
|
|
|
1339 (if (and attribution
|
|
|
1340 (looking-at regexp))
|
|
|
1341 (progn
|
|
|
1342 (delete-region
|
|
|
1343 (match-beginning 0)
|
|
|
1344 (save-excursion
|
|
|
1345 (goto-char (match-end 0))
|
|
|
1346 (if (bolp) (forward-char -1))
|
|
|
1347 (point)))
|
|
|
1348 (insert prefix)
|
|
|
1349 (sc-fill-if-different prefix)))
|
|
|
1350 nil))
|
|
|
1351
|
|
|
1352 (defun sc-cite-coerce-dumb-citer ()
|
|
|
1353 "Coerce a non-nested citation that's been cited with a dumb nesting citer."
|
|
|
1354 (delete-region (match-beginning 1) (match-end 1))
|
|
|
1355 (beginning-of-line)
|
|
|
1356 (sc-cite-coerce-cited-line))
|
|
|
1357
|
|
|
1358 (defun sc-guess-nesting (&optional string)
|
|
|
1359 "Guess the citation nesting on the current line.
|
|
|
1360 If nesting cannot be guessed, nil is returned. Optional STRING if
|
|
|
1361 supplied, is used instead of the line point is on in the current
|
|
|
1362 buffer."
|
|
|
1363 (let ((start 0)
|
|
51174
|
1364 (string (or string (buffer-substring (line-beginning-position)
|
|
|
1365 (line-end-position))))
|
|
4850
|
1366 nesting)
|
|
|
1367 (and
|
|
|
1368 (= start (or (string-match sc-citation-leader-regexp string start) -1))
|
|
|
1369 (setq start (match-end 0))
|
|
|
1370 (= start (or (string-match sc-citation-delimiter-regexp string start) -1))
|
|
51174
|
1371 (setq nesting (match-string 0 string)
|
|
4850
|
1372 start (match-end 0))
|
|
|
1373 (= start (or (string-match sc-citation-separator-regexp string start) -1))
|
|
|
1374 nesting)))
|
|
|
1375
|
|
|
1376 (defun sc-add-citation-level ()
|
|
14007
|
1377 "Add a citation level for nested citation style w/ coercion."
|
|
4850
|
1378 (let* ((nesting (sc-guess-nesting))
|
|
|
1379 (citation (make-string (1+ (length nesting))
|
|
|
1380 (string-to-char sc-citation-delimiter)))
|
|
|
1381 (prefix (concat sc-citation-leader citation sc-citation-separator)))
|
|
|
1382 (if (looking-at (sc-cite-regexp ""))
|
|
|
1383 (delete-region (match-beginning 0) (match-end 0)))
|
|
|
1384 (insert prefix)
|
|
|
1385 (sc-fill-if-different prefix)))
|
|
|
1386
|
|
|
1387 (defun sc-cite-line (&optional citation)
|
|
|
1388 "Cite a single line of uncited text.
|
|
|
1389 Optional CITATION overrides any citation automatically selected."
|
|
|
1390 (if sc-fixup-whitespace-p
|
|
|
1391 (fixup-whitespace))
|
|
|
1392 (let ((prefix (or citation
|
|
|
1393 (cdr (assoc "sc-citation" sc-mail-info))
|
|
|
1394 sc-default-attribution)))
|
|
|
1395 (insert prefix)
|
|
|
1396 (sc-fill-if-different prefix))
|
|
|
1397 nil)
|
|
|
1398
|
|
|
1399 (defun sc-uncite-line ()
|
|
|
1400 "Remove citation from current line."
|
|
|
1401 (let ((cited (looking-at (sc-cite-regexp))))
|
|
|
1402 (if cited
|
|
|
1403 (delete-region (match-beginning 0) (match-end 0))))
|
|
|
1404 nil)
|
|
|
1405
|
|
|
1406 (defun sc-recite-line (regexp)
|
|
|
1407 "Remove citation matching REGEXP from current line and recite line."
|
|
|
1408 (let ((cited (looking-at (concat "^" regexp)))
|
|
|
1409 (prefix (cdr (assoc "sc-citation" sc-mail-info))))
|
|
|
1410 (if cited
|
|
|
1411 (delete-region (match-beginning 0) (match-end 0)))
|
|
|
1412 (insert (or prefix sc-default-attribution))
|
|
|
1413 (sc-fill-if-different prefix))
|
|
|
1414 nil)
|
|
|
1415
|
|
|
1416 ;; interactive functions
|
57933
59c9a776a021
(sc-cite-region): Don't use interactive-p. Add arg INTERACTIVE.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1417 (defun sc-cite-region (start end &optional confirm-p interactive)
|
|
4850
|
1418 "Cite a region delineated by START and END.
|
|
|
1419 If optional CONFIRM-P is non-nil, the attribution is confirmed before
|
|
|
1420 its use in the citation string. This function first runs
|
57933
59c9a776a021
(sc-cite-region): Don't use interactive-p. Add arg INTERACTIVE.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1421 `sc-pre-cite-hook'.
|
59c9a776a021
(sc-cite-region): Don't use interactive-p. Add arg INTERACTIVE.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1422
|
59c9a776a021
(sc-cite-region): Don't use interactive-p. Add arg INTERACTIVE.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1423 When called interactively, the optional arg INTERACTIVE is non-nil,
|
59c9a776a021
(sc-cite-region): Don't use interactive-p. Add arg INTERACTIVE.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1424 and that means call `sc-select-attribution' too."
|
59c9a776a021
(sc-cite-region): Don't use interactive-p. Add arg INTERACTIVE.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1425 (interactive "r\nP\np")
|
|
4850
|
1426 (undo-boundary)
|
|
58952
|
1427 (let ((frame (sc-scan-info-alist sc-cite-frame-alist))
|
|
4850
|
1428 (sc-confirm-always-p (if confirm-p t sc-confirm-always-p)))
|
|
58952
|
1429 (if (and frame (symbolp frame))
|
|
|
1430 (setq frame (symbol-value frame)))
|
|
|
1431 (or frame (setq frame sc-default-cite-frame))
|
|
4850
|
1432 (run-hooks 'sc-pre-cite-hook)
|
57933
59c9a776a021
(sc-cite-region): Don't use interactive-p. Add arg INTERACTIVE.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1433 (if interactive
|
|
4850
|
1434 (sc-select-attribution))
|
|
|
1435 (regi-interpret frame start end)))
|
|
|
1436
|
|
|
1437 (defun sc-uncite-region (start end)
|
|
|
1438 "Uncite a region delineated by START and END.
|
|
|
1439 First runs `sc-pre-uncite-hook'."
|
|
|
1440 (interactive "r")
|
|
|
1441 (undo-boundary)
|
|
58952
|
1442 (let ((frame (sc-scan-info-alist sc-uncite-frame-alist)))
|
|
|
1443 (if (and frame (symbolp frame))
|
|
|
1444 (setq frame (symbol-value frame)))
|
|
|
1445 (or frame (setq frame sc-default-uncite-frame))
|
|
4850
|
1446 (run-hooks 'sc-pre-uncite-hook)
|
|
|
1447 (regi-interpret frame start end)))
|
|
49598
|
1448
|
|
4850
|
1449 (defun sc-recite-region (start end)
|
|
|
1450 "Recite a region delineated by START and END.
|
|
|
1451 First runs `sc-pre-recite-hook'."
|
|
|
1452 (interactive "r")
|
|
|
1453 (let ((sc-confirm-always-p t))
|
|
|
1454 (sc-select-attribution))
|
|
|
1455 (undo-boundary)
|
|
58952
|
1456 (let ((frame (sc-scan-info-alist sc-recite-frame-alist)))
|
|
|
1457 (if (and frame (symbolp frame))
|
|
|
1458 (setq frame (symbol-value frame)))
|
|
|
1459 (or frame (setq frame sc-default-recite-frame))
|
|
4850
|
1460 (run-hooks 'sc-pre-recite-hook)
|
|
|
1461 (regi-interpret frame start end)))
|
|
|
1462
|
|
|
1463
|
|
|
1464 ;; ======================================================================
|
|
|
1465 ;; building headers
|
|
|
1466
|
|
|
1467 (defun sc-hdr (prefix field &optional sep return-nil-p)
|
|
|
1468 "Returns a concatenation of PREFIX and FIELD.
|
|
|
1469 If FIELD is not a string or is the empty string, the empty string will
|
|
|
1470 be returned. Optional third argument SEP is concatenated on the end if
|
|
|
1471 it is a string. Returns empty string, unless optional RETURN-NIL-P is
|
|
|
1472 non-nil."
|
|
|
1473 (if (and (stringp field)
|
|
|
1474 (not (string= field "")))
|
|
|
1475 (concat prefix field (or sep ""))
|
|
|
1476 (and (not return-nil-p) "")))
|
|
|
1477
|
|
|
1478 (defun sc-whofrom ()
|
|
|
1479 "Return the value of (sc-mail-field \"from\") or nil."
|
|
|
1480 (let ((sc-mumble nil))
|
|
|
1481 (sc-mail-field "from")))
|
|
|
1482
|
|
|
1483 (defun sc-no-header ()
|
|
|
1484 "Does nothing. Use this instead of nil to get a blank header."
|
|
|
1485 ())
|
|
|
1486
|
|
|
1487 (defun sc-no-blank-line-or-header()
|
|
14007
|
1488 "Similar to `sc-no-header' except it removes the preceding blank line."
|
|
4850
|
1489 (if (not (bobp))
|
|
|
1490 (if (and (eolp)
|
|
|
1491 (progn (forward-line -1)
|
|
21861
|
1492 (or (= (point) (mail-header-end))
|
|
4850
|
1493 (and (eq major-mode 'mh-letter-mode)
|
|
64832
|
1494 (with-no-warnings
|
|
|
1495 (mh-in-header-p))))))
|
|
4850
|
1496 (progn (forward-line)
|
|
|
1497 (let ((kill-lines-magic t))
|
|
|
1498 (kill-line))))))
|
|
|
1499
|
|
|
1500 (defun sc-header-on-said ()
|
|
|
1501 "\"On <date>, <from> said:\" unless:
|
|
|
1502 1. the \"from\" field cannot be found, in which case nothing is inserted;
|
|
|
1503 2. the \"date\" field is missing in which case only the from part is printed."
|
|
|
1504 (let ((sc-mumble "")
|
|
|
1505 (whofrom (sc-whofrom)))
|
|
|
1506 (if whofrom
|
|
|
1507 (insert sc-reference-tag-string
|
|
|
1508 (sc-hdr "On " (sc-mail-field "date") ", ")
|
|
|
1509 whofrom " said:\n"))))
|
|
|
1510
|
|
|
1511 (defun sc-header-inarticle-writes ()
|
|
|
1512 "\"In article <message-id>, <from> writes:\"
|
|
|
1513 Treats \"message-id\" and \"from\" fields similar to `sc-header-on-said'."
|
|
|
1514 (let ((sc-mumble "")
|
|
|
1515 (whofrom (sc-mail-field "from")))
|
|
|
1516 (if whofrom
|
|
|
1517 (insert sc-reference-tag-string
|
|
|
1518 (sc-hdr "In article " (sc-mail-field "message-id") ", ")
|
|
|
1519 whofrom " writes:\n"))))
|
|
|
1520
|
|
|
1521 (defun sc-header-regarding-adds ()
|
|
|
1522 "\"Regarding <subject>; <from> adds:\"
|
|
|
1523 Treats \"subject\" and \"from\" fields similar to `sc-header-on-said'."
|
|
|
1524 (let ((sc-mumble "")
|
|
|
1525 (whofrom (sc-whofrom)))
|
|
|
1526 (if whofrom
|
|
|
1527 (insert sc-reference-tag-string
|
|
|
1528 (sc-hdr "Regarding " (sc-mail-field "subject") "; ")
|
|
|
1529 whofrom " adds:\n"))))
|
|
|
1530
|
|
|
1531 (defun sc-header-attributed-writes ()
|
|
|
1532 "\"<sc-attribution>\" == <sc-author> <address> writes:
|
|
|
1533 Treats these fields in a similar manner to `sc-header-on-said'."
|
|
|
1534 (let ((sc-mumble "")
|
|
|
1535 (whofrom (sc-whofrom)))
|
|
|
1536 (if whofrom
|
|
|
1537 (insert sc-reference-tag-string
|
|
|
1538 (sc-hdr "\"" (sc-mail-field "sc-attribution") "\" == ")
|
|
|
1539 (sc-hdr "" (sc-mail-field "sc-author") " ")
|
|
|
1540 (or (sc-hdr "<" (sc-mail-field "sc-from-address") ">" t)
|
|
|
1541 (sc-hdr "<" (sc-mail-field "sc-reply-address") ">" t)
|
|
|
1542 "")
|
|
|
1543 " writes:\n"))))
|
|
|
1544
|
|
|
1545 (defun sc-header-author-writes ()
|
|
|
1546 "<sc-author> writes:"
|
|
|
1547 (let ((sc-mumble "")
|
|
|
1548 (whofrom (sc-whofrom)))
|
|
|
1549 (if whofrom
|
|
|
1550 (insert sc-reference-tag-string
|
|
|
1551 (sc-hdr "" (sc-mail-field "sc-author"))
|
|
|
1552 " writes:\n"))))
|
|
|
1553
|
|
|
1554 (defun sc-header-verbose ()
|
|
|
1555 "Very verbose, some say gross."
|
|
|
1556 (let ((sc-mumble "")
|
|
|
1557 (whofrom (sc-whofrom))
|
|
|
1558 (tag sc-reference-tag-string))
|
|
|
1559 (if whofrom
|
|
|
1560 (insert (sc-hdr (concat tag "On ") (sc-mail-field "date") ",\n")
|
|
|
1561 (or (sc-hdr tag (sc-mail-field "sc-author") "\n" t)
|
|
|
1562 (concat tag whofrom "\n"))
|
|
|
1563 (sc-hdr (concat tag "from the organization of ")
|
|
|
1564 (sc-mail-field "organization") "\n")
|
|
|
1565 (let ((rtag (concat tag "who can be reached at: ")))
|
|
|
1566 (or (sc-hdr rtag (sc-mail-field "sc-from-address") "\n" t)
|
|
|
1567 (sc-hdr rtag (sc-mail-field "sc-reply-address") "\n" t)
|
|
|
1568 ""))
|
|
|
1569 (sc-hdr
|
|
|
1570 (concat tag "(whose comments are cited below with \"")
|
|
|
1571 (sc-mail-field "sc-citation") "\"),\n")
|
|
|
1572 (sc-hdr (concat tag "had this to say in article ")
|
|
|
1573 (sc-mail-field "message-id") "\n")
|
|
|
1574 (sc-hdr (concat tag "in newsgroups ")
|
|
|
1575 (sc-mail-field "newsgroups") "\n")
|
|
|
1576 (sc-hdr (concat tag "concerning the subject of ")
|
|
|
1577 (sc-mail-field "subject") "\n")
|
|
|
1578 (sc-hdr (concat tag "(see ")
|
|
|
1579 (sc-mail-field "references")
|
|
92814
|
1580 " for more details)\n")))))
|
|
4850
|
1581
|
|
|
1582
|
|
|
1583 ;; ======================================================================
|
|
|
1584 ;; header rewrites
|
|
|
1585
|
|
|
1586 (defconst sc-electric-bufname " *sc-erefs* "
|
|
|
1587 "Supercite electric reference mode's buffer name.")
|
|
|
1588 (defvar sc-eref-style 0
|
|
|
1589 "Current electric reference style.")
|
|
|
1590
|
|
|
1591 (defun sc-valid-index-p (index)
|
|
|
1592 "Returns INDEX if it is a valid index into `sc-rewrite-header-list'.
|
|
|
1593 Otherwise returns nil."
|
|
|
1594 ;; a number, and greater than or equal to zero
|
|
|
1595 ;; less than or equal to the last index
|
|
|
1596 (and (natnump index)
|
|
|
1597 (< index (length sc-rewrite-header-list))
|
|
|
1598 index))
|
|
|
1599
|
|
|
1600 (defun sc-eref-insert-selected (&optional nomsg)
|
|
|
1601 "Insert the selected reference header in the current buffer.
|
|
|
1602 Optional NOMSG, if non-nil, inhibits printing messages, unless an
|
|
|
1603 error occurs."
|
|
|
1604 (let ((ref (nth sc-eref-style sc-rewrite-header-list)))
|
|
|
1605 (condition-case err
|
|
|
1606 (progn
|
|
|
1607 (eval ref)
|
|
|
1608 (let ((lines (count-lines (point-min) (point-max))))
|
|
49598
|
1609 (or nomsg (message "Ref header %d [%d line%s]: %s"
|
|
4850
|
1610 sc-eref-style lines
|
|
|
1611 (if (= lines 1) "" "s")
|
|
|
1612 ref))))
|
|
|
1613 (void-function
|
|
|
1614 (progn (message
|
|
|
1615 "Symbol's function definition is void: %s (Header %d)"
|
|
92814
|
1616 (cadr err) sc-eref-style)
|
|
|
1617 (beep))))))
|
|
4850
|
1618
|
|
|
1619 (defun sc-electric-mode (&optional arg)
|
|
|
1620 "
|
|
|
1621 Mode for viewing Supercite reference headers. Commands are:
|
|
|
1622 \n\\{sc-electric-mode-map}
|
|
|
1623
|
|
|
1624 `sc-electric-mode' is not intended to be run interactively, but rather
|
|
|
1625 accessed through Supercite's electric reference feature. See
|
|
|
1626 `sc-insert-reference' for more details. Optional ARG is the initial
|
|
|
1627 header style to use, unless not supplied or invalid, in which case
|
|
|
1628 `sc-preferred-header-style' is used."
|
|
|
1629
|
|
|
1630 (let ((info sc-mail-info))
|
|
|
1631
|
|
|
1632 (setq sc-eref-style
|
|
|
1633 (or (sc-valid-index-p arg)
|
|
|
1634 (sc-valid-index-p sc-preferred-header-style)
|
|
|
1635 0))
|
|
|
1636
|
|
|
1637 (get-buffer-create sc-electric-bufname)
|
|
|
1638 ;; set up buffer and enter command loop
|
|
|
1639 (save-excursion
|
|
|
1640 (save-window-excursion
|
|
|
1641 (pop-to-buffer sc-electric-bufname)
|
|
|
1642 (kill-all-local-variables)
|
|
|
1643 (let ((sc-mail-info info)
|
|
|
1644 (buffer-read-only t)
|
|
|
1645 (mode-name "SC Electric Refs")
|
|
|
1646 (major-mode 'sc-electric-mode))
|
|
|
1647 (use-local-map sc-electric-mode-map)
|
|
|
1648 (sc-eref-show sc-eref-style)
|
|
62765
|
1649 (run-mode-hooks 'sc-electric-mode-hook)
|
|
92814
|
1650 (recursive-edit))))
|
|
4850
|
1651
|
|
|
1652 (and sc-eref-style
|
|
|
1653 (sc-eref-insert-selected))
|
|
92814
|
1654 (kill-buffer sc-electric-bufname)))
|
|
4850
|
1655
|
|
|
1656 ;; functions for electric reference mode
|
|
|
1657 (defun sc-eref-show (index)
|
|
|
1658 "Show reference INDEX in `sc-rewrite-header-list'."
|
|
|
1659 (let ((msg "No %ing reference headers in list.")
|
|
|
1660 (last (length sc-rewrite-header-list)))
|
|
|
1661 (setq sc-eref-style
|
|
|
1662 (cond
|
|
|
1663 ((sc-valid-index-p index) index)
|
|
|
1664 ((< index 0)
|
|
|
1665 (if sc-electric-circular-p
|
|
|
1666 (1- last)
|
|
|
1667 (progn (error msg "preced") 0)))
|
|
|
1668 ((>= index last)
|
|
|
1669 (if sc-electric-circular-p
|
|
|
1670 0
|
|
92814
|
1671 (progn (error msg "follow") (1- last))))))
|
|
4850
|
1672 (save-excursion
|
|
|
1673 (set-buffer sc-electric-bufname)
|
|
|
1674 (let ((buffer-read-only nil))
|
|
|
1675 (erase-buffer)
|
|
|
1676 (goto-char (point-min))
|
|
|
1677 (sc-eref-insert-selected)
|
|
|
1678 ;; now shrink the window to just contain the electric reference
|
|
|
1679 ;; header.
|
|
|
1680 (let ((hdrlines (count-lines (point-min) (point-max)))
|
|
|
1681 (winlines (1- (window-height))))
|
|
|
1682 (if (/= hdrlines winlines)
|
|
|
1683 (if (> hdrlines winlines)
|
|
|
1684 ;; we have to enlarge the window
|
|
|
1685 (enlarge-window (- hdrlines winlines))
|
|
|
1686 ;; we have to shrink the window
|
|
92814
|
1687 (shrink-window (- winlines (max hdrlines
|
|
|
1688 window-min-height))))))))))
|
|
4850
|
1689
|
|
|
1690 (defun sc-eref-next ()
|
|
|
1691 "Display next reference in other buffer."
|
|
|
1692 (interactive)
|
|
|
1693 (sc-eref-show (1+ sc-eref-style)))
|
|
|
1694
|
|
|
1695 (defun sc-eref-prev ()
|
|
|
1696 "Display previous reference in other buffer."
|
|
|
1697 (interactive)
|
|
|
1698 (sc-eref-show (1- sc-eref-style)))
|
|
|
1699
|
|
|
1700 (defun sc-eref-setn ()
|
|
|
1701 "Set reference header selected as preferred."
|
|
|
1702 (interactive)
|
|
|
1703 (setq sc-preferred-header-style sc-eref-style)
|
|
|
1704 (message "Preferred reference style set to header %d." sc-eref-style))
|
|
|
1705
|
|
|
1706 (defun sc-eref-goto (refnum)
|
|
|
1707 "Show reference style indexed by REFNUM.
|
|
|
1708 If REFNUM is an invalid index, don't go to that reference and return
|
|
|
1709 nil."
|
|
|
1710 (interactive "NGoto Reference: ")
|
|
|
1711 (if (sc-valid-index-p refnum)
|
|
|
1712 (sc-eref-show refnum)
|
|
|
1713 (error "Invalid reference: %d. (Range: [%d .. %d])"
|
|
92814
|
1714 refnum 0 (1- (length sc-rewrite-header-list)))))
|
|
4850
|
1715
|
|
|
1716 (defun sc-eref-jump ()
|
|
|
1717 "Set reference header to preferred header."
|
|
|
1718 (interactive)
|
|
|
1719 (sc-eref-show sc-preferred-header-style))
|
|
|
1720
|
|
|
1721 (defun sc-eref-abort ()
|
|
|
1722 "Exit from electric reference mode without inserting reference."
|
|
|
1723 (interactive)
|
|
|
1724 (setq sc-eref-style nil)
|
|
|
1725 (exit-recursive-edit))
|
|
|
1726
|
|
|
1727 (defun sc-eref-exit ()
|
|
|
1728 "Exit from electric reference mode and insert selected reference."
|
|
|
1729 (interactive)
|
|
|
1730 (exit-recursive-edit))
|
|
|
1731
|
|
|
1732 (defun sc-insert-reference (arg)
|
|
|
1733 "Insert, at point, a reference header in the body of the reply.
|
|
|
1734 Numeric ARG indicates which header style from `sc-rewrite-header-list'
|
|
|
1735 to use when rewriting the header. No supplied ARG indicates use of
|
|
|
1736 `sc-preferred-header-style'.
|
|
|
1737
|
|
|
1738 With just `\\[universal-argument]', electric reference insert mode is
|
|
|
1739 entered, regardless of the value of `sc-electric-references-p'. See
|
|
|
1740 `sc-electric-mode' for more information."
|
|
|
1741 (interactive "P")
|
|
|
1742 (if (consp arg)
|
|
|
1743 (sc-electric-mode)
|
|
|
1744 (let ((preference (or (sc-valid-index-p arg)
|
|
|
1745 (sc-valid-index-p sc-preferred-header-style)
|
|
|
1746 sc-preferred-header-style
|
|
|
1747 0)))
|
|
|
1748 (if sc-electric-references-p
|
|
|
1749 (sc-electric-mode preference)
|
|
92814
|
1750 (sc-eref-insert-selected t)))))
|
|
4850
|
1751
|
|
|
1752
|
|
|
1753 ;; ======================================================================
|
|
|
1754 ;; variable toggling
|
|
|
1755
|
|
|
1756 (defun sc-raw-mode-toggle ()
|
|
|
1757 "Toggle, in one fell swoop, two important SC variables:
|
|
|
1758 `sc-fixup-whitespace-p' and `sc-auto-fill-region-p'"
|
|
|
1759 (interactive)
|
|
|
1760 (setq sc-fixup-whitespace-p (not sc-fixup-whitespace-p)
|
|
|
1761 sc-auto-fill-region-p (not sc-auto-fill-region-p))
|
|
11571
|
1762 (force-mode-line-update))
|
|
4850
|
1763
|
|
|
1764 (defun sc-toggle-var (variable)
|
|
|
1765 "Boolean toggle VARIABLE's value.
|
|
42206
|
1766 VARIABLE must be a bound symbol. nil values change to t, non-nil
|
|
4850
|
1767 values are changed to nil."
|
|
|
1768 (message "%s changed from %s to %s"
|
|
|
1769 variable (symbol-value variable)
|
|
51174
|
1770 (set variable (not (symbol-value variable)))))
|
|
4850
|
1771
|
|
|
1772 (defun sc-set-variable (var)
|
|
|
1773 "Set the Supercite VARIABLE.
|
|
|
1774 This function mimics `set-variable', except that the variable to set
|
|
|
1775 is determined non-interactively. The value is queried for in the
|
|
|
1776 minibuffer exactly the same way that `set-variable' does it.
|
|
|
1777
|
|
|
1778 You can see the current value of the variable when the minibuffer is
|
|
|
1779 querying you by typing `C-h'. Note that the format is changed
|
|
|
1780 slightly from that used by `set-variable' -- the current value is
|
|
|
1781 printed just after the variable's name instead of at the bottom of the
|
|
|
1782 help window."
|
|
51174
|
1783 (let* ((minibuffer-help-form '(funcall myhelp))
|
|
4850
|
1784 (myhelp
|
|
51174
|
1785 (lambda ()
|
|
|
1786 (with-output-to-temp-buffer "*Help*"
|
|
|
1787 (prin1 var)
|
|
|
1788 (if (boundp var)
|
|
|
1789 (let ((print-length 20))
|
|
|
1790 (princ "\t(Current value: ")
|
|
|
1791 (prin1 (symbol-value var))
|
|
|
1792 (princ ")")))
|
|
|
1793 (princ "\n\nDocumentation:\n")
|
|
|
1794 (princ (substring (documentation-property
|
|
|
1795 var
|
|
|
1796 'variable-documentation)
|
|
|
1797 1))
|
|
|
1798 (with-current-buffer standard-output
|
|
|
1799 (help-mode))
|
|
|
1800 nil))))
|
|
|
1801 (set var (eval-minibuffer (format "Set %s to value: " var)))))
|
|
4850
|
1802
|
|
|
1803 (defmacro sc-toggle-symbol (rootname)
|
|
51174
|
1804 `(defun ,(intern (concat "sc-T-" rootname)) ()
|
|
|
1805 (interactive)
|
|
|
1806 (sc-toggle-var ',(intern (concat "sc-" rootname "-p")))))
|
|
4850
|
1807
|
|
|
1808 (defmacro sc-setvar-symbol (rootname)
|
|
51174
|
1809 `(defun ,(intern (concat "sc-S-" rootname)) ()
|
|
|
1810 (interactive)
|
|
|
1811 (sc-set-variable ',(intern (concat "sc-" rootname)))))
|
|
4850
|
1812
|
|
|
1813 (sc-toggle-symbol "confirm-always")
|
|
|
1814 (sc-toggle-symbol "downcase")
|
|
|
1815 (sc-toggle-symbol "electric-references")
|
|
|
1816 (sc-toggle-symbol "auto-fill-region")
|
|
|
1817 (sc-toggle-symbol "mail-nuke-blank-lines")
|
|
|
1818 (sc-toggle-symbol "nested-citation")
|
|
|
1819 (sc-toggle-symbol "electric-circular")
|
|
|
1820 (sc-toggle-symbol "use-only-preferences")
|
|
|
1821 (sc-toggle-symbol "fixup-whitespace")
|
|
|
1822
|
|
|
1823 (sc-setvar-symbol "preferred-attribution-list")
|
|
|
1824 (sc-setvar-symbol "preferred-header-style")
|
|
|
1825 (sc-setvar-symbol "mail-nuke-mail-headers")
|
|
|
1826 (sc-setvar-symbol "mail-header-nuke-list")
|
|
|
1827 (sc-setvar-symbol "cite-region-limit")
|
|
|
1828
|
|
|
1829 (defun sc-T-describe ()
|
|
|
1830 "
|
|
|
1831
|
|
|
1832 Supercite provides a number of key bindings which simplify the process
|
|
|
1833 of setting or toggling certain variables controlling its operation.
|
|
|
1834
|
|
|
1835 Note on function names in this list: all functions of the form
|
|
|
1836 `sc-S-<name>' actually call `sc-set-variable' on the corresponding
|
|
|
1837 `sc-<name>' variable. All functions of the form `sc-T-<name>' call
|
|
|
1838 `sc-toggle-var' on the corresponding `sc-<name>-p' variable.
|
|
|
1839
|
|
|
1840 \\{sc-T-keymap}"
|
|
|
1841 (interactive)
|
|
|
1842 (describe-function 'sc-T-describe))
|
|
|
1843
|
|
|
1844
|
|
|
1845 ;; ======================================================================
|
|
|
1846 ;; published interface to mail and news readers
|
|
|
1847
|
|
51174
|
1848 (define-minor-mode sc-minor-mode
|
|
|
1849 "Supercite minor mode."
|
|
61282
|
1850 :group 'supercite
|
|
|
1851 :lighter (" SC" (sc-auto-fill-region-p
|
|
|
1852 (":f" (sc-fixup-whitespace-p "w"))
|
|
|
1853 (sc-fixup-whitespace-p ":w")))
|
|
|
1854 :keymap `((,sc-mode-map-prefix . ,sc-mode-map)))
|
|
51174
|
1855
|
|
7370
|
1856 ;;;###autoload
|
|
4850
|
1857 (defun sc-cite-original ()
|
|
|
1858 "Workhorse citing function which performs the initial citation.
|
|
|
1859 This is callable from the various mail and news readers' reply
|
|
51174
|
1860 function according to the agreed upon standard. See the associated
|
|
|
1861 info node `(SC)Top' for more details.
|
|
|
1862 `sc-cite-original' does not do any yanking of the
|
|
4850
|
1863 original message but it does require a few things:
|
|
|
1864
|
|
|
1865 1) The reply buffer is the current buffer.
|
|
|
1866
|
|
|
1867 2) The original message has been yanked and inserted into the
|
|
|
1868 reply buffer.
|
|
|
1869
|
|
|
1870 3) Verbose mail headers from the original message have been
|
|
|
1871 inserted into the reply buffer directly before the text of the
|
|
|
1872 original message.
|
|
|
1873
|
|
|
1874 4) Point is at the beginning of the verbose headers.
|
|
|
1875
|
|
|
1876 5) Mark is at the end of the body of text to be cited.
|
|
|
1877
|
|
92244
|
1878 The region need not be active (and typically isn't when this
|
|
|
1879 function is called). Also, the hook `sc-pre-hook' is run before,
|
|
|
1880 and `sc-post-hook' is run after the guts of this function."
|
|
4850
|
1881 (run-hooks 'sc-pre-hook)
|
|
|
1882
|
|
51174
|
1883 (sc-minor-mode 1)
|
|
4850
|
1884
|
|
|
1885 (undo-boundary)
|
|
|
1886
|
|
|
1887 ;; grab point and mark since the region is probably not active when
|
|
|
1888 ;; this function gets automatically called. we want point to be a
|
|
|
1889 ;; mark so any deleting before point works properly
|
|
51174
|
1890 (let* ((zmacs-regions nil) ; for XEemacs
|
|
24876
|
1891 (mark-active t) ; for Emacs
|
|
4850
|
1892 (point (point-marker))
|
|
|
1893 (mark (copy-marker (mark-marker))))
|
|
49598
|
1894
|
|
4850
|
1895 ;; make sure point comes before mark, not all functions are
|
|
|
1896 ;; interactive "r"
|
|
|
1897 (if (< mark point)
|
|
|
1898 (let ((tmp point))
|
|
|
1899 (setq point mark
|
|
|
1900 mark tmp)))
|
|
|
1901
|
|
|
1902 ;; first process mail headers, and populate sc-mail-info
|
|
|
1903 (sc-mail-process-headers point mark)
|
|
|
1904
|
|
|
1905 ;; now get possible attributions
|
|
|
1906 (sc-attribs-chop-address (or (sc-mail-field "from")
|
|
|
1907 (sc-mail-field "reply")
|
|
|
1908 (sc-mail-field "reply-to")
|
|
|
1909 (sc-mail-field "sender")))
|
|
|
1910 ;; select the attribution
|
|
|
1911 (sc-select-attribution)
|
|
|
1912
|
|
|
1913 ;; cite the region, but first check the value of sc-cite-region-limit
|
|
|
1914 (let ((linecnt (count-lines point mark)))
|
|
|
1915 (and sc-cite-region-limit
|
|
|
1916 (if (or (not (numberp sc-cite-region-limit))
|
|
|
1917 (<= linecnt sc-cite-region-limit))
|
|
|
1918 (progn
|
|
|
1919 ;; cite the region and insert the header rewrite
|
|
|
1920 (sc-cite-region point mark)
|
|
|
1921 (goto-char point)
|
|
|
1922 (let ((sc-eref-style (or sc-preferred-header-style 0)))
|
|
|
1923 (if sc-electric-references-p
|
|
|
1924 (sc-electric-mode sc-eref-style)
|
|
|
1925 (sc-eref-insert-selected t))))
|
|
|
1926 (beep)
|
|
|
1927 (message
|
|
|
1928 "Region not cited. %d lines exceeds sc-cite-region-limit: %d"
|
|
|
1929 linecnt sc-cite-region-limit))))
|
|
|
1930
|
|
|
1931 ;; finally, free the point-marker
|
|
|
1932 (set-marker point nil)
|
|
92814
|
1933 (set-marker mark nil))
|
|
51174
|
1934 (run-hooks 'sc-post-hook))
|
|
4850
|
1935
|
|
|
1936
|
|
|
1937 ;; ======================================================================
|
|
|
1938 ;; bug reporting and miscellaneous commands
|
|
|
1939
|
|
|
1940 (defun sc-open-line (arg)
|
|
|
1941 "Like `open-line', but insert the citation prefix at the front of the line.
|
|
|
1942 With numeric ARG, inserts that many new lines."
|
|
|
1943 (interactive "p")
|
|
|
1944 (save-excursion
|
|
|
1945 (let ((start (point))
|
|
|
1946 (prefix (or (progn (beginning-of-line)
|
|
|
1947 (if (looking-at (sc-cite-regexp))
|
|
51174
|
1948 (match-string 0)))
|
|
4850
|
1949 "")))
|
|
|
1950 (goto-char start)
|
|
|
1951 (open-line arg)
|
|
|
1952 (forward-line 1)
|
|
|
1953 (while (< 0 arg)
|
|
|
1954 (insert prefix)
|
|
|
1955 (forward-line 1)
|
|
92244
|
1956 (setq arg (1- arg))))))
|
|
4850
|
1957
|
|
|
1958 (defun sc-insert-citation (arg)
|
|
|
1959 "Insert citation string at beginning of current line if not already cited.
|
|
|
1960 With `\\[universal-argument]' insert citation even if line is already
|
|
|
1961 cited."
|
|
|
1962 (interactive "P")
|
|
|
1963 (save-excursion
|
|
|
1964 (beginning-of-line)
|
|
|
1965 (if (or (not (looking-at (sc-cite-regexp)))
|
|
|
1966 (looking-at "^[ \t]*$")
|
|
|
1967 (consp arg))
|
|
|
1968 (insert (sc-mail-field "sc-citation"))
|
|
38436
|
1969 (error "Line is already cited"))))
|
|
4850
|
1970
|
|
102651
|
1971 ;; The argument logic here is crazy.
|
57933
59c9a776a021
(sc-cite-region): Don't use interactive-p. Add arg INTERACTIVE.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1972 (defun sc-version (message)
|
|
102651
|
1973 "Return the current Supercite version.
|
57933
59c9a776a021
(sc-cite-region): Don't use interactive-p. Add arg INTERACTIVE.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1974 If MESSAGE is non-nil (interactively, with no prefix argument),
|
|
102651
|
1975 echoes the version in the minibuffer. Otherwise, inserts the
|
|
|
1976 version at point."
|
|
102650
|
1977 (interactive (list (not current-prefix-arg)))
|
|
86773
|
1978 (let ((verstr (format "Using Supercite.el %s" emacs-version)))
|
57933
59c9a776a021
(sc-cite-region): Don't use interactive-p. Add arg INTERACTIVE.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1979 (if message
|
59c9a776a021
(sc-cite-region): Don't use interactive-p. Add arg INTERACTIVE.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1980 (message verstr)
|
59c9a776a021
(sc-cite-region): Don't use interactive-p. Add arg INTERACTIVE.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1981 (insert "`sc-version' says: " verstr))))
|
|
4850
|
1982
|
|
92244
|
1983 (make-obsolete 'sc-version 'emacs-version "23.1")
|
|
|
1984
|
|
4850
|
1985 (defun sc-describe ()
|
|
92244
|
1986 "Read the Supercite info node."
|
|
4850
|
1987 (interactive)
|
|
92244
|
1988 (info "(SC)top"))
|
|
|
1989
|
|
92263
|
1990 (make-obsolete 'sc-describe "read the SC manual using `info'." "23.1")
|
|
4850
|
1991
|
|
86532
|
1992 (define-obsolete-function-alias 'sc-submit-bug-report 'report-emacs-bug "23.1")
|
|
4850
|
1993
|
|
|
1994
|
|
|
1995 ;; useful stuff
|
|
|
1996 (provide 'supercite)
|
|
|
1997 (run-hooks 'sc-load-hook)
|
|
|
1998
|
|
61044
|
1999 ;; arch-tag: a5d5bfa6-3bd5-4414-8c65-0afc83e45cd3
|
|
4850
|
2000 ;;; supercite.el ends here
|
