Commit | Line | Data |
---|---|---|
ac96728d RS |
1 | ;; -*- Mode: Emacs-Lisp -*- |
2 | ;; sc.el -- Version 2.3 (used to be supercite.el) | |
3 | ||
4 | ;; ========== Introduction ========== | |
5 | ;; Citation and attribution package for various GNU emacs news and | |
6 | ;; electronic mail reading subsystems. This version of supercite will | |
7 | ;; interface to VM 4.40+ and MH-E 3.7 (shipped w/ emacs 18.57) as is. | |
8 | ;; It will also interface with GNUS 3.12+, RMAIL 18.55+, GNEWS, and | |
9 | ;; probably most other news/mail subsystems by using the overloading | |
10 | ;; functions provided in sc-oloads.el (see that file or the README for | |
11 | ;; more information on interfacing supercite with your reader subsystem). | |
12 | ;; This version should now be compatible with Lucid Emacs 19.x emacses. | |
13 | ||
14 | ;; This package does not do any yanking of messages, but instead | |
15 | ;; massages raw reply buffers set up by the reply/forward functions in | |
16 | ;; the news/mail subsystems. Therefore, such useful operations as | |
17 | ;; yanking and citing portions of the original article (instead of the | |
18 | ;; whole article) are not within the ability or responsiblity of | |
19 | ;; supercite. | |
20 | ||
21 | ;; ========== Disclaimer ========== | |
22 | ;; This software is distributed in the hope that it will be useful, | |
23 | ;; but WITHOUT ANY WARRANTY. No author or distributor, nor any | |
24 | ;; author's past, present, or future employers accepts responsibility | |
25 | ;; to anyone for the consequences of using it or for whether it serves | |
26 | ;; any particular purpose or works at all, unless he says so in | |
27 | ;; writing. | |
28 | ||
29 | ;; Some of this software was written as part of the supercite author's | |
30 | ;; official duty as an employee of the United States Government and is | |
31 | ;; thus not subject to copyright. You are free to use that particular | |
32 | ;; software as you wish, but WITHOUT ANY WARRANTY WHATSOEVER. It | |
33 | ;; would be nice, though if when you use any of this or other freely | |
34 | ;; available code, you give due credit to the author. | |
35 | ||
36 | ;; Other parts of this code were written by other people. Wherever | |
37 | ;; possible, credit to that author, and the copy* notice supplied by | |
38 | ;; the author are included with that code. The supercite author is no | |
39 | ;; longer an employee of the U.S. Government so the GNU Public Licence | |
40 | ;; should be considered in effect for all enhancements and bug fixes | |
41 | ;; performed by the author. | |
42 | ||
43 | ;; ========== Author (unless otherwise stated) ======================== | |
44 | ;; NAME: Barry A. Warsaw USMAIL: Century Computing, Inc. | |
45 | ;; TELE: (301) 593-3330 1014 West Street | |
46 | ;; INET: bwarsaw@cen.com Laurel, Md 20707 | |
47 | ;; UUCP: uunet!cen.com!bwarsaw | |
48 | ;; | |
49 | ;; Want to be on the Supercite mailing list? | |
50 | ;; | |
51 | ;; Send articles to: | |
52 | ;; Internet: supercite@anthem.nlm.nih.gov | |
53 | ;; UUCP: uunet!anthem.nlm.nih.gov!supercite | |
54 | ;; | |
55 | ;; Send administrivia (additions/deletions to list, etc) to: | |
56 | ;; Internet: supercite-request@anthem.nlm.nih.gov | |
57 | ;; UUCP: uunet!anthem.nlm.nih.gov!supercite-request | |
58 | ||
59 | ;; ========== Credits and Thanks ========== | |
60 | ;; This package was derived from the Superyank 1.11 package as posted | |
61 | ;; to the net. Superyank 1.11 was inspired by code and ideas from | |
62 | ;; Martin Neitzel and Ashwin Ram. Supercite version 2.3 has evolved | |
63 | ;; through the comments and suggestions of the supercite mailing list | |
64 | ;; which consists of many authors and users of the various mail and | |
65 | ;; news reading subsystems. | |
66 | ||
67 | ;; Many folks on the supercite mailing list have contributed their | |
68 | ;; help in debugging, making suggestions and supplying support code or | |
69 | ;; bug fixes for the previous versions of supercite. I want to thank | |
70 | ;; everyone who helped, especially (in no particular order): | |
71 | ;; | |
72 | ;; Mark D. Baushke, Khalid Sattar, David Lawrence, Chris Davis, Kyle | |
73 | ;; Jones, Kayvan Sylvan, Masanobu Umeda, Dan Jacobson, Piet van | |
74 | ;; Oostrum, Hamish (H.I.) Macdonald, and Joe Wells. | |
75 | ;; | |
76 | ;; I don't mean to leave anyone out. All who have helped have been | |
77 | ;; appreciated. | |
78 | ||
79 | ;; ========== Getting Started ========== | |
80 | ;; Here is a quick guide to getting started with supercite. The | |
81 | ;; information contained here is mostly excerpted from the more | |
82 | ;; detailed explanations given in the accompanying README file. | |
83 | ;; Naturally, there are many customizations you can do to give your | |
84 | ;; replies that personalized flair, but the instructions in this | |
85 | ;; section should be sufficient for getting started. | |
86 | ||
87 | ;; With this release of supercite overloading is the only supported | |
88 | ;; way to get supercite hooked into your favorite news/mail reading | |
89 | ;; subsystems. Overloading will be necessary for RMAIL, GNUS, GNEWS, | |
90 | ;; RNEWS and PCMAIL. Overloading will not be needed for VM 4.37+ or | |
91 | ;; MH-E 3.7+. MH-E comes with emacs 18.57 but if you have an earlier | |
92 | ;; version of emacs, you should be able to ftp MH-E 3.7 separately. Or | |
93 | ;; you can extract the MH-E overloading stuff from version 2.1's | |
94 | ;; sc-oloads.el. | |
95 | ||
96 | ;; First, to connect supercite to any mail/news reading subsystem, put | |
97 | ;; this in your .emacs file: | |
98 | ;; | |
99 | ;; (setq mail-yank-hooks 'sc-cite-original) ; for all but MH-E | |
100 | ;; (setq mh-yank-hooks 'sc-cite-original) ; for MH-E only | |
101 | ;; | |
102 | ;; If supercite is not pre-loaded into your emacs session, you should | |
103 | ;; add the following autoload: | |
104 | ;; | |
105 | ;; (autoload 'sc-cite-original "sc" "Supercite 2.3" t) | |
106 | ;; | |
107 | ;; Then, if you need to overload, put the following in your .emacs file: | |
108 | ;; | |
109 | ;; (defun my-sc-overload-hook () | |
110 | ;; (require 'sc-oloads) ; be sure this file is on your load-path | |
111 | ;; (sc-overload-functions)) | |
112 | ;; | |
113 | ;; (setq news-reply-mode-hook 'my-sc-overload-hook) ; for RNEWS,GNUS,GNEWS | |
114 | ;; (setq mail-setup-hook 'my-sc-overload-hook) ; for RMAIL, PCMAIL | |
115 | ;; | |
116 | ;; Finally, if you want to customize supercite, you should do it in a | |
117 | ;; function called my-supercite-hook and: | |
118 | ;; | |
119 | ;; (setq sc-load-hook 'my-supercite-hook) | |
120 | ||
121 | (require 'sc-alist) | |
122 | ||
123 | \f | |
124 | ;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv | |
125 | ;; start of user defined variables | |
126 | ;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv | |
127 | ||
128 | (defvar sc-nested-citation-p nil | |
129 | "*Controls whether to use nested or non-nested citation style. | |
130 | Non-nil uses nested citations, nil uses non-nested citations. Type | |
131 | \\[sc-describe] for more information.") | |
132 | ||
133 | (defvar sc-citation-leader " " | |
134 | "*String comprising first part of a citation.") | |
135 | ||
136 | (defvar sc-citation-delimiter ">" | |
137 | "*String comprising third part of a citation. | |
138 | This string is used in both nested and non-nested citations.") | |
139 | ||
140 | (defvar sc-citation-separator " " | |
141 | "*String comprising fourth and last part of a citation.") | |
142 | ||
143 | (defvar sc-default-author-name "Anonymous" | |
144 | "*String used when author's name cannot be determined.") | |
145 | ||
146 | (defvar sc-default-attribution "Anon" | |
147 | "*String used when author's attribution cannot be determined.") | |
148 | ||
149 | ;; Noriya KOBAYASHI (nk@ics.osaka-u.ac.jp) writes to the supercite | |
150 | ;; mailing list: | |
151 | ;; I use supercite in Nemacs-3.3.2. In order to handle citation using | |
152 | ;; Kanji, [...set sc-cite-regexp to...] | |
153 | ;; "\\s *\\([a-zA-Z0-9]\\|\\cc\\|\\cC\\|\\ch\\|\\cH\\|\\ck\\|\\cK\\)*\\s *>+" | |
154 | ;; | |
155 | (defvar sc-cite-regexp "\\s *[-a-zA-Z0-9_.]*>+\\s *" | |
156 | "*Regular expression describing how a already cited line begins. | |
157 | The regexp is only used at the beginning of a line, so it doesn't need | |
158 | to start with a '^'.") | |
159 | ||
160 | (defvar sc-titlecue-regexp "\\s +-+\\s +" | |
161 | "*Regular expression describing the separator between names and titles. | |
162 | Set to nil to treat entire field as a name.") | |
163 | ||
164 | (defvar sc-spacify-name-chars '(?_ ?* ?+ ?=) | |
165 | "*List of characters to convert to spaces if found in an author's name.") | |
166 | ||
167 | (defvar sc-nicknames-alist | |
168 | '(("Michael" "Mike") | |
169 | ("Daniel" "Dan") | |
170 | ("David" "Dave") | |
171 | ("Jonathan" "John") | |
172 | ("William" "Bill") | |
173 | ("Elizabeth" "Beth") | |
174 | ("Elizabeth" "Betsy") | |
175 | ("Kathleen" "Kathy") | |
176 | ("Smith" "Smitty")) | |
177 | "*Association list of names and their common nicknames. | |
178 | Entries are of the form (NAME NICKNAME), and NAMEs can have more than | |
179 | one nickname. Nicknames will not be automatically used as an | |
180 | attribution string, since I'm not sure this is really polite, but if a | |
181 | name is glommed from the author name and presented in the attribution | |
182 | string completion list, the matching nicknames will also be presented. | |
183 | Set this variable to nil to defeat nickname expansions. Also note that | |
184 | nicknames are not put in the supercite information alist.") | |
185 | ||
186 | (defvar sc-confirm-always-p t | |
187 | "*If non-nil, always confirm attribution string before citing text body.") | |
188 | ||
189 | (defvar sc-preferred-attribution 'firstname | |
190 | "*Specifies which part of the author's name becomes the attribution. | |
191 | The value of this variable must be one of the following quoted symbols: | |
192 | ||
193 | emailname -- email terminus name | |
194 | initials -- initials of author | |
195 | firstname -- first name of author | |
196 | lastname -- last name of author | |
197 | middlename1 -- first middle name of author | |
198 | middlename2 -- second middle name of author | |
199 | ... | |
200 | ||
201 | Middle name indexes can be any positive integer greater than 0, though | |
202 | it is unlikely that many authors will supply more than one middle | |
203 | name, if that many.") | |
204 | ||
205 | (defvar sc-use-only-preference-p nil | |
206 | "*Controls what happens when the preferred attribution cannot be found. | |
207 | If non-nil, then sc-default-attribution will be used. If nil, then | |
208 | some secondary scheme will be employed to find a suitable attribution | |
209 | string.") | |
210 | ||
211 | (defvar sc-downcase-p nil | |
212 | "*Non-nil means downcase the attribution and citation strings.") | |
213 | ||
214 | (defvar sc-rewrite-header-list | |
215 | '((sc-no-header) | |
216 | (sc-header-on-said) | |
217 | (sc-header-inarticle-writes) | |
218 | (sc-header-regarding-adds) | |
219 | (sc-header-attributed-writes) | |
220 | (sc-header-verbose) | |
221 | (sc-no-blank-line-or-header) | |
222 | ) | |
223 | "*List of reference header rewrite functions. | |
224 | The variable sc-preferred-header-style controls which function in this | |
225 | list is chosen for automatic reference header insertions. Electric | |
226 | reference mode will cycle through this list of functions. For more | |
227 | information, type \\[sc-describe].") | |
228 | ||
229 | (defvar sc-preferred-header-style 1 | |
230 | "*Index into sc-rewrite-header-list specifying preferred header style. | |
231 | Index zero accesses the first function in the list.") | |
232 | ||
233 | (defvar sc-electric-references-p t | |
234 | "*Use electric references if non-nil.") | |
235 | ||
236 | (defvar sc-electric-circular-p t | |
237 | "*Treat electric references as circular if non-nil.") | |
238 | ||
239 | (defvar sc-mail-fields-list | |
240 | '("date" "message-id" "subject" "newsgroups" "references" | |
241 | "from" "return-path" "path" "reply-to" "organization" | |
242 | "reply" ) | |
243 | "*List of mail header whose values will be saved by supercite. | |
244 | These values can be used in header rewrite functions by accessing them | |
245 | with the sc-field function. Mail headers in this list are case | |
246 | insensitive and do not require a trailing colon.") | |
247 | ||
248 | (defvar sc-mumble-string "" | |
249 | "*Value returned by sc-field if chosen field cannot be found.") | |
250 | ||
251 | (defvar sc-nuke-mail-headers-p t | |
252 | "*Nuke or don't nuke mail headers. | |
253 | If non-nil, nuke mail headers after gleaning useful information from | |
254 | them.") | |
255 | ||
256 | (defvar sc-reference-tag-string ">>>>> " | |
257 | "*String used at the beginning of built-in reference headers.") | |
258 | ||
259 | (defvar sc-fill-paragraph-hook 'sc-fill-paragraph | |
260 | "*Hook for filling a paragraph. | |
261 | This hook gets executed when you fill a paragraph either manually or | |
262 | automagically. It expects point to be within the extent of the | |
263 | paragraph that is going to be filled. This hook allows you to use a | |
264 | different paragraph filling package than the one supplied with | |
265 | supercite.") | |
266 | ||
267 | (defvar sc-auto-fill-region-p nil | |
268 | "*If non-nil, automatically fill each paragraph after it has been cited.") | |
269 | ||
270 | (defvar sc-auto-fill-query-each-paragraph-p nil | |
271 | "*If non-nil, query before filling each paragraph. | |
272 | No querying and no filling will be performed if sc-auto-fill-region-p | |
273 | is set to nil.") | |
274 | ||
275 | (defvar sc-fixup-whitespace-p nil | |
276 | "*If non-nil, delete all leading white space before citing.") | |
277 | ||
278 | (defvar sc-all-but-cite-p nil | |
279 | "*If non-nil, sc-cite-original does everything but cite the text. | |
280 | This is useful for manually citing large messages, or portions of | |
281 | large messages. When non-nil, sc-cite-original will still set up all | |
282 | necessary variables and databases, but will skip the citing routine | |
283 | which modify the reply buffer's text.") | |
284 | ||
285 | (defvar sc-load-hook nil | |
286 | "*User definable hook. | |
287 | Runs after supercite is loaded. Set your customizations here.") | |
288 | ||
289 | (defvar sc-pre-hook nil | |
290 | "*User definable hook. | |
291 | Runs before sc-cite-original executes.") | |
292 | ||
293 | (defvar sc-post-hook nil | |
294 | "*User definable hook. | |
295 | Runs after sc-cite-original executes.") | |
296 | ||
297 | (defvar sc-header-nuke-list | |
298 | '("via" "origin" "status" "received" "remailed" "cc" "sender" "replied" | |
299 | "organization" "keywords" "distribution" "xref" "references" "expires" | |
300 | "approved" "summary" "precedence" "subject" "newsgroup[s]?" | |
301 | "\\(followup\\|apparently\\|errors\\|\\(\\(in-\\)?reply\\)?-\\)?to" | |
302 | "x-[a-z0-9-]+" "[a-z-]*message-id" "\\(summary-\\)?line[s]" | |
303 | "\\(\\(return\\|reply\\)-\\)?path" "\\(posted-\\)?date" | |
304 | "\\(mail-\\)?from") | |
305 | "*List of mail headers to remove from body of reply.") | |
306 | ||
307 | ||
308 | \f | |
309 | ;; ====================================================================== | |
310 | ;; keymaps | |
311 | ||
312 | (defvar sc-default-keymap | |
313 | '(lambda () | |
314 | (local-set-key "\C-c\C-r" 'sc-insert-reference) | |
315 | (local-set-key "\C-c\C-t" 'sc-cite) | |
316 | (local-set-key "\C-c\C-a" 'sc-recite) | |
317 | (local-set-key "\C-c\C-u" 'sc-uncite) | |
318 | (local-set-key "\C-c\C-i" 'sc-insert-citation) | |
319 | (local-set-key "\C-c\C-o" 'sc-open-line) | |
320 | (local-set-key "\C-c\C-q" 'sc-fill-paragraph-manually) | |
321 | (local-set-key "\C-cq" 'sc-fill-paragraph-manually) | |
322 | (local-set-key "\C-c\C-m" 'sc-modify-information) | |
323 | (local-set-key "\C-cf" 'sc-view-field) | |
324 | (local-set-key "\C-cg" 'sc-glom-headers) | |
325 | (local-set-key "\C-c\C-v" 'sc-version) | |
326 | (local-set-key "\C-c?" 'sc-describe) | |
327 | ) | |
328 | "*Default keymap if major-mode can't be found in `sc-local-keymaps'.") | |
329 | ||
330 | (defvar sc-local-keymaps | |
331 | '((mail-mode | |
332 | (lambda () | |
333 | (local-set-key "\C-c\C-r" 'sc-insert-reference) | |
334 | (local-set-key "\C-c\C-t" 'sc-cite) | |
335 | (local-set-key "\C-c\C-a" 'sc-recite) | |
336 | (local-set-key "\C-c\C-u" 'sc-uncite) | |
337 | (local-set-key "\C-c\C-i" 'sc-insert-citation) | |
338 | (local-set-key "\C-c\C-o" 'sc-open-line) | |
339 | (local-set-key "\C-c\C-q" 'sc-fill-paragraph-manually) | |
340 | (local-set-key "\C-cq" 'sc-fill-paragraph-manually) | |
341 | (local-set-key "\C-c\C-m" 'sc-modify-information) | |
342 | (local-set-key "\C-cf" 'sc-view-field) | |
343 | (local-set-key "\C-cg" 'sc-glom-headers) | |
344 | (local-set-key "\C-c\C-v" 'sc-version) | |
345 | (local-set-key "\C-c?" 'sc-describe) | |
346 | )) | |
347 | (mh-letter-mode | |
348 | (lambda () | |
349 | (local-set-key "\C-c\C-r" 'sc-insert-reference) | |
350 | (local-set-key "\C-c\C-t" 'sc-cite) | |
351 | (local-set-key "\C-c\C-a" 'sc-recite) | |
352 | (local-set-key "\C-c\C-u" 'sc-uncite) | |
353 | (local-set-key "\C-ci" 'sc-insert-citation) | |
354 | (local-set-key "\C-c\C-o" 'sc-open-line) | |
355 | (local-set-key "\C-cq" 'sc-fill-paragraph-manually) | |
356 | (local-set-key "\C-c\C-m" 'sc-modify-information) | |
357 | (local-set-key "\C-cf" 'sc-view-field) | |
358 | (local-set-key "\C-cg" 'sc-glom-headers) | |
359 | (local-set-key "\C-c\C-v" 'sc-version) | |
360 | (local-set-key "\C-c?" 'sc-describe) | |
361 | )) | |
362 | (news-reply-mode mail-mode) | |
363 | (vm-mail-mode mail-mode) | |
364 | (e-reply-mode mail-mode) | |
365 | (n-reply-mode mail-mode) | |
366 | ) | |
367 | "*List of keymaps to use with the associated major-mode.") | |
368 | ||
369 | (defvar sc-electric-mode-map nil | |
370 | "*Keymap for sc-electric-mode.") | |
371 | ||
372 | (if sc-electric-mode-map | |
373 | nil | |
374 | (setq sc-electric-mode-map (make-sparse-keymap)) | |
375 | (define-key sc-electric-mode-map "p" 'sc-eref-prev) | |
376 | (define-key sc-electric-mode-map "n" 'sc-eref-next) | |
377 | (define-key sc-electric-mode-map "s" 'sc-eref-setn) | |
378 | (define-key sc-electric-mode-map "j" 'sc-eref-jump) | |
379 | (define-key sc-electric-mode-map "x" 'sc-eref-abort) | |
380 | (define-key sc-electric-mode-map "\r" 'sc-eref-exit) | |
381 | (define-key sc-electric-mode-map "\n" 'sc-eref-exit) | |
382 | (define-key sc-electric-mode-map "q" 'sc-eref-exit) | |
383 | (define-key sc-electric-mode-map "g" 'sc-eref-goto) | |
384 | ) | |
385 | ||
386 | ;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ | |
387 | ;; end of user defined variables | |
388 | ;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ | |
389 | ||
390 | \f | |
391 | ;; ====================================================================== | |
392 | ;; global variables, not user accessable | |
393 | ||
394 | (defconst sc-version-number "2.3" | |
395 | "Supercite's version number.") | |
396 | ||
397 | ;; when rnewspost.el patch is installed (or function is overloaded) | |
398 | ;; this should be nil since supercite now does this itself. | |
399 | (setq news-reply-header-hook nil) | |
400 | ||
401 | ;; autoload for sc-electric-mode | |
402 | (autoload 'sc-electric-mode "sc-elec" | |
403 | "Quasi-major mode for viewing supercite reference headers." nil) | |
404 | ||
405 | ;; global alists (gals), misc variables. make new bytecompiler happy | |
406 | (defvar sc-gal-information nil | |
407 | "Internal global alist variable containing information.") | |
408 | (defvar sc-gal-attributions nil | |
409 | "Internal global alist variable containing attributions.") | |
410 | (defvar sc-fill-arg nil | |
411 | "Internal fill argument holder.") | |
412 | (defvar sc-cite-context nil | |
413 | "Internal citation context holder.") | |
414 | (defvar sc-force-confirmation-p nil | |
415 | "Internal variable.") | |
416 | ||
417 | (make-variable-buffer-local 'sc-gal-attributions) | |
418 | (make-variable-buffer-local 'sc-gal-information) | |
419 | (make-variable-buffer-local 'sc-leached-keymap) | |
420 | (make-variable-buffer-local 'sc-fill-arg) | |
421 | (make-variable-buffer-local 'sc-cite-context) | |
422 | ||
423 | (setq-default sc-gal-attributions nil) | |
424 | (setq-default sc-gal-information nil) | |
425 | (setq-default sc-leached-keymap (current-local-map)) | |
426 | (setq-default sc-fill-arg nil) | |
427 | (setq-default sc-cite-context nil) | |
428 | ||
429 | ||
430 | \f | |
431 | ;; ====================================================================== | |
432 | ;; miscellaneous support functions | |
433 | ||
434 | (defun sc-mark () | |
435 | "Mark compatibility between emacs v18 and v19." | |
436 | (let ((zmacs-regions nil)) | |
437 | (mark))) | |
438 | ||
439 | (defun sc-update-gal (attribution) | |
440 | "Update the information alist. | |
441 | Add ATTRIBUTION and compose the nested and non-nested citation | |
442 | strings." | |
443 | (let ((attrib (if sc-downcase-p (downcase attribution) attribution))) | |
444 | (aput 'sc-gal-information "sc-attribution" attrib) | |
445 | (aput 'sc-gal-information "sc-nested-citation" | |
446 | (concat attrib sc-citation-delimiter)) | |
447 | (aput 'sc-gal-information "sc-citation" | |
448 | (concat sc-citation-leader | |
449 | attrib | |
450 | sc-citation-delimiter | |
451 | sc-citation-separator)))) | |
452 | ||
453 | (defun sc-valid-index-p (index) | |
454 | "Returns t if INDEX is a valid index into sc-rewrite-header-list." | |
455 | (let ((last (1- (length sc-rewrite-header-list)))) | |
456 | (and (natnump index) ;; a number, and greater than or equal to zero | |
457 | (<= index last) ;; less than or equal to the last index | |
458 | ))) | |
459 | ||
460 | (defun sc-string-car (namestring) | |
461 | "Return the string-equivalent \"car\" of NAMESTRING. | |
462 | ||
463 | example: (sc-string-car \"John Xavier Doe\") | |
464 | => \"John\"" | |
465 | (substring namestring | |
466 | (progn (string-match "\\s *" namestring) (match-end 0)) | |
467 | (progn (string-match "\\s *\\S +" namestring) (match-end 0)))) | |
468 | ||
469 | (defun sc-string-cdr (namestring) | |
470 | "Return the string-equivalent \"cdr\" of NAMESTRING. | |
471 | ||
472 | example: (sc-string-cdr \"John Xavier Doe\") | |
473 | => \"Xavier Doe\"" | |
474 | (substring namestring | |
475 | (progn (string-match "\\s *\\S +\\s *" namestring) | |
476 | (match-end 0)))) | |
477 | ||
478 | (defun sc-linepos (&optional position col-p) | |
479 | "Return the character position at various line positions. | |
480 | Optional POSITION can be one of the following symbols: | |
481 | bol == beginning of line | |
482 | boi == beginning of indentation | |
483 | eol == end of line [default] | |
484 | ||
485 | Optional COL-P non-nil returns current-column instead of character position." | |
486 | (let ((tpnt (point)) | |
487 | rval) | |
488 | (cond | |
489 | ((eq position 'bol) (beginning-of-line)) | |
490 | ((eq position 'boi) (back-to-indentation)) | |
491 | (t (end-of-line))) | |
492 | (setq rval (if col-p (current-column) (point))) | |
493 | (goto-char tpnt) | |
494 | rval)) | |
495 | ||
496 | \f | |
497 | ;; ====================================================================== | |
498 | ;; this section snarfs mail fields and places them in the info alist | |
499 | ||
500 | (defun sc-build-header-zap-regexp () | |
501 | "Return a regexp for sc-mail-yank-clear-headers." | |
502 | (let ((headers sc-header-nuke-list) | |
503 | (regexp nil)) | |
504 | (while headers | |
505 | (setq regexp (concat regexp | |
506 | "^" (car headers) ":" | |
507 | (if (cdr headers) "\\|" nil))) | |
508 | (setq headers (cdr headers))) | |
509 | regexp)) | |
510 | ||
511 | (defun sc-mail-yank-clear-headers (start end) | |
512 | "Nuke mail headers between START and END." | |
513 | (if (and sc-nuke-mail-headers-p sc-header-nuke-list) | |
514 | (let ((regexp (sc-build-header-zap-regexp))) | |
515 | (save-excursion | |
516 | (goto-char start) | |
517 | (if (search-forward "\n\n" end t) | |
518 | (save-restriction | |
519 | (narrow-to-region start (point)) | |
520 | (goto-char start) | |
521 | (while (let ((case-fold-search t)) | |
522 | (re-search-forward regexp nil t)) | |
523 | (beginning-of-line) | |
524 | (delete-region (point) | |
525 | (progn (re-search-forward "\n[^ \t]") | |
526 | (forward-char -1) | |
527 | (point))) | |
528 | ))) | |
529 | )))) | |
530 | ||
531 | (defun sc-mail-fetch-field (field) | |
532 | "Return the value of the header field FIELD. | |
533 | The buffer is expected to be narrowed to just the headers of the | |
534 | message." | |
535 | (save-excursion | |
536 | (goto-char (point-min)) | |
537 | (let ((case-fold-search t) | |
538 | (name (concat "^" (regexp-quote field) "[ \t]*:[ \t]*"))) | |
539 | (goto-char (point-min)) | |
540 | (if (re-search-forward name nil t) | |
541 | (let ((opoint (point))) | |
542 | (while (progn (forward-line 1) | |
543 | (looking-at "[ \t]"))) | |
544 | (buffer-substring opoint (1- (point)))))))) | |
545 | ||
546 | (defun sc-fetch-fields (start end) | |
547 | "Fetch the mail fields in the region from START to END. | |
548 | These fields can be accessed in header rewrite functions with sc-field." | |
549 | (save-excursion | |
550 | (save-restriction | |
551 | (narrow-to-region start end) | |
552 | (goto-char start) | |
553 | (let ((fields sc-mail-fields-list)) | |
554 | (while fields | |
555 | (let ((value (sc-mail-fetch-field (car fields))) | |
556 | (next (cdr fields))) | |
557 | (and value | |
558 | (aput 'sc-gal-information (car fields) value)) | |
559 | (setq fields next))) | |
560 | (if (sc-mail-fetch-field "from") | |
561 | (aput 'sc-gal-information "from" (sc-mail-fetch-field "from"))))))) | |
562 | ||
563 | (defun sc-field (field) | |
564 | "Return the alist information associated with the FIELD. | |
565 | If FIELD is not a valid key, return sc-mumble-string." | |
566 | (or (aget sc-gal-information field) sc-mumble-string)) | |
567 | ||
568 | \f | |
569 | ;; ====================================================================== | |
570 | ;; built-in reference header rewrite functions | |
571 | ||
572 | (defun sc-no-header () | |
573 | "Does nothing. Use this instead of nil to get a blank header." | |
574 | ()) | |
575 | ||
576 | (defun sc-no-blank-line-or-header() | |
577 | "Similar to sc-no-header except it removes the preceeding blank line." | |
578 | (if (not (bobp)) | |
579 | (if (and (eolp) | |
580 | (progn (forward-line -1) | |
581 | (or (looking-at mail-header-separator) | |
582 | (and (eq major-mode 'mh-letter-mode) | |
583 | (mh-in-header-p))))) | |
584 | (progn (forward-line) | |
585 | (let ((kill-lines-magic t)) (kill-line)))))) | |
586 | ||
587 | (defun sc-header-on-said () | |
588 | "\"On <date>, <from> said:\", unless 1. the \"from\" field cannot be | |
589 | found, in which case nothing is inserted; or 2. the \"date\" field is | |
590 | missing in which case only the from part is printed." | |
591 | (let* ((sc-mumble-string "") | |
592 | (whofrom (sc-field "from")) | |
593 | (when (sc-field "date"))) | |
594 | (if (not (string= whofrom "")) | |
595 | (insert sc-reference-tag-string | |
596 | (if (not (string= when "")) | |
597 | (concat "On " when ", ") "") | |
598 | whofrom " said:\n")))) | |
599 | ||
600 | (defun sc-header-inarticle-writes () | |
601 | "\"In article <message-id>, <from> writes:\" | |
602 | Treats \"message-id\" and \"from\" fields similar to sc-header-on-said." | |
603 | (let* ((sc-mumble-string "") | |
604 | (whofrom (sc-field "from")) | |
605 | (msgid (sc-field "message-id"))) | |
606 | (if (not (string= whofrom "")) | |
607 | (insert sc-reference-tag-string | |
608 | (if (not (string= msgid "")) | |
609 | (concat "In article " msgid ", ") "") | |
610 | whofrom " writes:\n")))) | |
611 | ||
612 | (defun sc-header-regarding-adds () | |
613 | "\"Regarding <subject>; <from> adds:\" | |
614 | Treats \"subject\" and \"from\" fields similar to sc-header-on-said." | |
615 | (let* ((sc-mumble-string "") | |
616 | (whofrom (sc-field "from")) | |
617 | (subj (sc-field "subject"))) | |
618 | (if (not (string= whofrom "")) | |
619 | (insert sc-reference-tag-string | |
620 | (if (not (string= subj "")) | |
621 | (concat "Regarding " subj "; ") "") | |
622 | whofrom " adds:\n")))) | |
623 | ||
624 | (defun sc-header-attributed-writes () | |
625 | "\"<sc-attribution>\" == <sc-author> <address> writes: | |
626 | Treats these fields in a similar manner to sc-header-on-said." | |
627 | (let* ((sc-mumble-string "") | |
628 | (whofrom (sc-field "from")) | |
629 | (reply (sc-field "sc-reply-address")) | |
630 | (from (sc-field "sc-from-address")) | |
631 | (attr (sc-field "sc-attribution")) | |
632 | (auth (sc-field "sc-author"))) | |
633 | (if (not (string= whofrom "")) | |
634 | (insert sc-reference-tag-string | |
635 | (if (not (string= attr "")) | |
636 | (concat "\"" attr "\" == " ) "") | |
637 | (if (not (string= auth "")) | |
638 | (concat auth " ") "") | |
639 | (if (not (string= reply "")) | |
640 | (concat "<" reply ">") | |
641 | (if (not (string= from "")) | |
642 | (concat "<" from ">") "")) | |
643 | " writes:\n")))) | |
644 | ||
645 | (defun sc-header-verbose () | |
646 | "Very verbose, some say gross." | |
647 | (let* ((sc-mumble-string "") | |
648 | (whofrom (sc-field "from")) | |
649 | (reply (sc-field "sc-reply-address")) | |
650 | (from (sc-field "sc-from-address")) | |
651 | (author (sc-field "sc-author")) | |
652 | (date (sc-field "date")) | |
653 | (org (sc-field "organization")) | |
654 | (msgid (sc-field "message-id")) | |
655 | (ngrps (sc-field "newsgroups")) | |
656 | (subj (sc-field "subject")) | |
657 | (refs (sc-field "references")) | |
658 | (cite (sc-field "sc-citation")) | |
659 | (nl sc-reference-tag-string)) | |
660 | (if (not (string= whofrom "")) | |
661 | (insert (if (not (string= date "")) | |
662 | (concat nl "On " date ",\n") "") | |
663 | (concat nl (if (not (string= author "")) | |
664 | author | |
665 | whofrom) "\n") | |
666 | (if (not (string= org "")) | |
667 | (concat nl "from the organization of " org "\n") "") | |
668 | (if (not (string= reply "")) | |
669 | (concat nl "who can be reached at: " reply "\n") | |
670 | (if (not (string= from "")) | |
671 | (concat nl "who can be reached at: " from "\n") "")) | |
672 | (if (not (string= cite "")) | |
673 | (concat nl "(whose comments are cited below with \"" | |
674 | cite "\"),\n") "") | |
675 | (if (not (string= msgid "")) | |
676 | (concat nl "had this to say in article " msgid "\n") "") | |
677 | (if (not (string= ngrps "")) | |
678 | (concat nl "in newsgroups " ngrps "\n") "") | |
679 | (if (not (string= subj "")) | |
680 | (concat nl "concerning the subject of " subj "\n") "") | |
681 | (if (not (string= refs "")) | |
682 | (concat nl "(see " refs " for more details)\n") "") | |
683 | )))) | |
684 | ||
685 | \f | |
686 | ;; ====================================================================== | |
687 | ;; this section queries the user for necessary information | |
688 | ||
689 | (defun sc-query (&optional default) | |
690 | "Query for an attribution string with the optional DEFAULT choice. | |
691 | Returns the string entered by the user, if non-empty and non-nil, or | |
692 | DEFAULT otherwise. If DEFAULT is not supplied, sc-default-attribution | |
693 | is used." | |
694 | (if (not default) (setq default sc-default-attribution)) | |
695 | (let* ((prompt (concat "Enter attribution string: (default " default ") ")) | |
696 | (query (read-string prompt))) | |
697 | (if (or (null query) | |
698 | (string= query "")) | |
699 | default | |
700 | query))) | |
701 | ||
702 | (defun sc-confirm () | |
703 | "Confirm the preferred attribution with the user." | |
704 | (if (or sc-confirm-always-p | |
705 | sc-force-confirmation-p) | |
706 | (aput 'sc-gal-attributions | |
707 | (let* ((default (aheadsym sc-gal-attributions)) | |
708 | chosen | |
709 | (prompt (concat "Complete " | |
710 | (cond | |
711 | ((eq sc-cite-context 'citing) "cite") | |
712 | ((eq sc-cite-context 'reciting) "recite") | |
713 | (t "")) | |
714 | " attribution string: (default " | |
715 | default ") ")) | |
716 | (minibuffer-local-completion-map | |
717 | (copy-keymap minibuffer-local-completion-map))) | |
718 | (define-key minibuffer-local-completion-map "\C-g" | |
719 | '(lambda () (interactive) (beep) (throw 'select-abort nil))) | |
720 | (setq chosen (completing-read prompt sc-gal-attributions)) | |
721 | (if (or (not chosen) | |
722 | (string= chosen "")) | |
723 | default | |
724 | chosen))))) | |
725 | ||
726 | \f | |
727 | ;; ====================================================================== | |
728 | ;; this section contains primitive functions used in the email address | |
729 | ;; parsing schemes. they extract name fields from various parts of | |
730 | ;; the "from:" field. | |
731 | ||
732 | (defun sc-style1-addresses (from-string &optional delim) | |
733 | "Extract the author's email terminus from email address FROM-STRING. | |
734 | Match addresses of the style \"name%[stuff].\" when called with DELIM | |
735 | of \"%\" and addresses of the style \"[stuff]name@[stuff]\" when | |
736 | called with DELIM \"@\". If DELIM is nil or not provided, matches | |
737 | addresses of the style \"name\"." | |
738 | (and (string-match (concat "[a-zA-Z0-9_-]+" delim) from-string 0) | |
739 | (substring from-string | |
740 | (match-beginning 0) | |
741 | (- (match-end 0) (if (null delim) 0 1))))) | |
742 | ||
743 | (defun sc-style2-addresses (from-string) | |
744 | "Extract the author's email terminus from email address FROM-STRING. | |
745 | Match addresses of the style \"[stuff]![stuff]...!name[stuff].\"" | |
746 | (let ((eos (length from-string)) | |
747 | (mstart (string-match "![a-zA-Z0-9_-]+\\([^!a-zA-Z0-9_-]\\|$\\)" | |
748 | from-string 0)) | |
749 | (mend (match-end 0))) | |
750 | (and mstart | |
751 | (substring from-string (1+ mstart) (- mend (if (= mend eos) 0 1))) | |
752 | ))) | |
753 | ||
754 | (defun sc-get-address (from-string author) | |
755 | "Get the full email address path from FROM-STRING. | |
756 | AUTHOR is the author's name (which is removed from the address)." | |
757 | (let ((eos (length from-string))) | |
758 | (if (string-match (concat "\\(^\\|^\"\\)" author | |
759 | "\\(\\s +\\|\"\\s +\\)") from-string 0) | |
760 | (let ((addr (substring from-string (match-end 0) eos))) | |
761 | (if (and (= (aref addr 0) ?<) | |
762 | (= (aref addr (1- (length addr))) ?>)) | |
763 | (substring addr 1 (1- (length addr))) | |
764 | addr)) | |
765 | (if (string-match "[a-zA-Z0-9!@%._-]+" from-string 0) | |
766 | (substring from-string (match-beginning 0) (match-end 0)) | |
767 | "") | |
768 | ))) | |
769 | ||
770 | (defun sc-get-emailname (from-string) | |
771 | "Get the email terminus name from FROM-STRING." | |
772 | (cond | |
773 | ((sc-style1-addresses from-string "%")) | |
774 | ((sc-style1-addresses from-string "@")) | |
775 | ((sc-style2-addresses from-string)) | |
776 | ((sc-style1-addresses from-string nil)) | |
777 | (t (substring from-string 0 10)))) | |
778 | ||
779 | \f | |
780 | ;; ====================================================================== | |
781 | ;; this section contains functions that will extract a list of names | |
782 | ;; from the name field string. | |
783 | ||
784 | (defun sc-spacify-name-chars (name) | |
785 | (let ((len (length name)) | |
786 | (s 0)) | |
787 | (while (< s len) | |
788 | (if (memq (aref name s) sc-spacify-name-chars) | |
789 | (aset name s 32)) | |
790 | (setq s (1+ s))) | |
791 | name)) | |
792 | ||
793 | (defun sc-name-substring (string start end extend) | |
794 | "Extract the specified substring of STRING from START to END. | |
795 | EXTEND is the number of characters on each side to extend the | |
796 | substring." | |
797 | (and start | |
798 | (let ((sos (+ start extend)) | |
799 | (eos (- end extend))) | |
800 | (substring string sos | |
801 | (or (string-match sc-titlecue-regexp string sos) eos) | |
802 | )))) | |
803 | ||
804 | (defun sc-extract-namestring (from-string) | |
805 | "Extract the name string from FROM-STRING. | |
806 | This should be the author's full name minus an optional title." | |
807 | (let ((pstart (string-match "(.*)" from-string 0)) | |
808 | (pend (match-end 0)) | |
809 | (qstart (string-match "\".*\"" from-string 0)) | |
810 | (qend (match-end 0)) | |
811 | (bstart (string-match "\\([.a-zA-Z0-9_-]+\\s *\\)+" from-string 0)) | |
812 | (bend (match-end 0))) | |
813 | (sc-spacify-name-chars | |
814 | (cond | |
815 | ((sc-name-substring from-string pstart pend 1)) | |
816 | ((sc-name-substring from-string qstart qend 1)) | |
817 | ((sc-name-substring from-string bstart bend 0)) | |
818 | )))) | |
819 | ||
820 | (defun sc-chop-namestring (namestring) | |
821 | "Convert NAMESTRING to a list of names. | |
822 | ||
823 | example: (sc-namestring-to-list \"John Xavier Doe\") | |
824 | => (\"John\" \"Xavier\" \"Doe\")" | |
825 | (if (not (string= namestring "")) | |
826 | (append (list (sc-string-car namestring)) | |
827 | (sc-chop-namestring (sc-string-cdr namestring))))) | |
828 | ||
829 | (defun sc-strip-initials (namelist) | |
830 | "Extract the author's initials from the NAMELIST." | |
831 | (if (not namelist) | |
832 | nil | |
833 | (concat (if (string= (car namelist) "") | |
834 | "" | |
835 | (substring (car namelist) 0 1)) | |
836 | (sc-strip-initials (cdr namelist))))) | |
837 | ||
838 | \f | |
839 | ;; ====================================================================== | |
840 | ;; this section handles selection of the attribution and citation strings | |
841 | ||
842 | (defun sc-populate-alists (from-string) | |
843 | "Put important and useful information in the alists using FROM-STRING. | |
844 | Return the list of name symbols." | |
845 | (let* ((namelist (sc-chop-namestring (sc-extract-namestring from-string))) | |
846 | (revnames (reverse (cdr namelist))) | |
847 | (midnames (reverse (cdr revnames))) | |
848 | (firstname (car namelist)) | |
849 | (midnames (reverse (cdr revnames))) | |
850 | (lastname (car revnames)) | |
851 | (initials (sc-strip-initials namelist)) | |
852 | (emailname (sc-get-emailname from-string)) | |
853 | (n 1) | |
854 | (symlist (list 'emailname 'initials 'firstname 'lastname))) | |
855 | ||
856 | ;; put basic information | |
857 | (aput 'sc-gal-attributions 'firstname firstname) | |
858 | (aput 'sc-gal-attributions 'lastname lastname) | |
859 | (aput 'sc-gal-attributions 'emailname emailname) | |
860 | (aput 'sc-gal-attributions 'initials initials) | |
861 | ||
862 | (aput 'sc-gal-information "sc-firstname" firstname) | |
863 | (aput 'sc-gal-information "sc-lastname" lastname) | |
864 | (aput 'sc-gal-information "sc-emailname" emailname) | |
865 | (aput 'sc-gal-information "sc-initials" initials) | |
866 | ||
867 | ;; put middle names and build sc-author entry | |
868 | (let ((author (concat firstname " "))) | |
869 | (while midnames | |
870 | (let ((name (car midnames)) | |
871 | (next (cdr midnames)) | |
872 | (symbol (intern (format "middlename%d" n))) | |
873 | (string (format "sc-middlename-%d" n))) | |
874 | ;; first put new middlename | |
875 | (aput 'sc-gal-attributions symbol name) | |
876 | (aput 'sc-gal-information string name) | |
877 | (setq n (1+ n)) | |
878 | (nconc symlist (list symbol)) | |
879 | ||
880 | ;; now build author name | |
881 | (setq author (concat author name " ")) | |
882 | ||
883 | ;; incr loop | |
884 | (setq midnames next) | |
885 | )) | |
886 | (setq author (concat author lastname)) | |
887 | ||
888 | ;; put author name and email address | |
889 | (aput 'sc-gal-information "sc-author" author) | |
890 | (aput 'sc-gal-information "sc-from-address" | |
891 | (sc-get-address from-string author)) | |
892 | (aput 'sc-gal-information "sc-reply-address" | |
893 | (sc-get-address (sc-field "reply-to") author)) | |
894 | ) | |
895 | ;; return value | |
896 | symlist)) | |
897 | ||
898 | (defun sc-sort-attribution-alist () | |
899 | "Put preferred attribution at head of attributions alist." | |
900 | (asort 'sc-gal-attributions sc-preferred-attribution) | |
901 | ||
902 | ;; use backup scheme if preference is not legal | |
903 | (if (or (null sc-preferred-attribution) | |
904 | (anot-head-p sc-gal-attributions sc-preferred-attribution) | |
905 | (let ((prefval (aget sc-gal-attributions | |
906 | sc-preferred-attribution))) | |
907 | (or (null prefval) | |
908 | (string= prefval "")))) | |
909 | ;; no legal attribution | |
910 | (if sc-use-only-preference-p | |
911 | (aput 'sc-gal-attributions 'sc-user-query | |
912 | (sc-query sc-default-attribution)) | |
913 | ;; else use secondary scheme | |
914 | (asort 'sc-gal-attributions 'firstname)))) | |
915 | ||
916 | (defun sc-build-attribution-alist (from-string) | |
917 | "Extract attributions from FROM-STRING, applying preferences." | |
918 | (let ((symlist (sc-populate-alists from-string)) | |
919 | (headval (progn (sc-sort-attribution-alist) | |
920 | (aget sc-gal-attributions | |
921 | (aheadsym sc-gal-attributions) t)))) | |
922 | ||
923 | ;; for each element in the symlist, remove the corresponding | |
924 | ;; key-value pair in the alist, then insert just the value. | |
925 | (while symlist | |
926 | (let ((value (aget sc-gal-attributions (car symlist) t)) | |
927 | (next (cdr symlist))) | |
928 | (if (not (or (null value) | |
929 | (string= value ""))) | |
930 | (aput 'sc-gal-attributions value)) | |
931 | (adelete 'sc-gal-attributions (car symlist)) | |
932 | (setq symlist next))) | |
933 | ||
934 | ;; add nicknames to the completion list | |
935 | (let ((gal sc-gal-attributions)) | |
936 | (while gal | |
937 | (let ((nns sc-nicknames-alist) | |
938 | (galname (car (car gal)))) | |
939 | (while nns | |
940 | (if (string= galname (car (car nns))) | |
941 | (aput 'sc-gal-attributions (car (cdr (car nns))))) | |
942 | (setq nns (cdr nns))) | |
943 | (setq gal (cdr gal))))) | |
944 | ||
945 | ;; now reinsert the head (preferred) attribution unless it is nil, | |
946 | ;; this effectively just moves the head value to the front of the | |
947 | ;; list. | |
948 | (if headval | |
949 | (aput 'sc-gal-attributions headval)) | |
950 | ||
951 | ;; check to be sure alist is not nil | |
952 | (if (null sc-gal-attributions) | |
953 | (aput 'sc-gal-attributions sc-default-attribution)))) | |
954 | ||
955 | (defun sc-select () | |
956 | "Select an attribution and create a citation string." | |
957 | (cond | |
958 | (sc-nested-citation-p | |
959 | (sc-update-gal "")) | |
960 | ((null (aget sc-gal-information "from" t)) | |
961 | (aput 'sc-gal-information "sc-author" sc-default-author-name) | |
962 | (sc-update-gal (sc-query sc-default-attribution))) | |
963 | ((null sc-gal-attributions) | |
964 | (sc-build-attribution-alist (aget sc-gal-information "from" t)) | |
965 | (sc-confirm) | |
966 | (sc-update-gal (aheadsym sc-gal-attributions))) | |
967 | (t | |
968 | (sc-confirm) | |
969 | (sc-update-gal (aheadsym sc-gal-attributions)))) | |
970 | t) | |
971 | ||
972 | \f | |
973 | ;; ====================================================================== | |
974 | ;; region citing and unciting | |
975 | ||
976 | (defun sc-cite-region (start end) | |
977 | "Cite a region delineated by START and END." | |
978 | (save-excursion | |
979 | ;; set real end-of-region | |
980 | (goto-char end) | |
981 | (forward-line 1) | |
982 | (set-mark (point)) | |
983 | ;; goto real beginning-of-region | |
984 | (goto-char start) | |
985 | (beginning-of-line) | |
986 | (let ((fstart (point)) | |
987 | (fend (point))) | |
988 | (while (< (point) (sc-mark)) | |
989 | ;; remove leading whitespace if desired | |
990 | (and sc-fixup-whitespace-p | |
991 | (fixup-whitespace)) | |
992 | ;; if end of line then perhaps autofill | |
993 | (cond ((eolp) | |
994 | (or (= fstart fend) | |
995 | (not sc-auto-fill-region-p) | |
996 | (and sc-auto-fill-query-each-paragraph-p | |
997 | (not (y-or-n-p "Fill this paragraph? "))) | |
998 | (save-excursion (set-mark fend) | |
999 | (goto-char (/ (+ fstart fend 1) 2)) | |
1000 | (run-hooks 'sc-fill-paragraph-hook))) | |
1001 | (setq fstart (point) | |
1002 | fend (point))) | |
1003 | ;; not end of line so perhap cite it | |
1004 | ((not (looking-at sc-cite-regexp)) | |
1005 | (insert (aget sc-gal-information "sc-citation"))) | |
1006 | (sc-nested-citation-p | |
1007 | (insert (aget sc-gal-information "sc-nested-citation")))) | |
1008 | (setq fend (point)) | |
1009 | (forward-line 1)) | |
1010 | (and sc-auto-fill-query-each-paragraph-p | |
1011 | (message " ")) | |
1012 | ))) | |
1013 | ||
1014 | (defun sc-uncite-region (start end cite-regexp) | |
1015 | "Uncite a previously cited region delineated by START and END. | |
1016 | CITE-REGEXP describes how a cited line of texts starts. Unciting also | |
1017 | auto-fills paragraph if sc-auto-fill-region-p is non-nil." | |
1018 | (save-excursion | |
1019 | (set-mark end) | |
1020 | (goto-char start) | |
1021 | (beginning-of-line) | |
1022 | (let ((fstart (point)) | |
1023 | (fend (point))) | |
1024 | (while (< (point) (sc-mark)) | |
1025 | ;; if end of line, then perhaps autofill | |
1026 | (cond ((eolp) | |
1027 | (or (= fstart fend) | |
1028 | (not sc-auto-fill-region-p) | |
1029 | (and sc-auto-fill-query-each-paragraph-p | |
1030 | (not (y-or-n-p "Fill this paragraph? "))) | |
1031 | (save-excursion (set-mark fend) | |
1032 | (goto-char (/ (+ fstart fend 1) 2)) | |
1033 | (run-hooks 'sc-fill-paragraph-hook))) | |
1034 | (setq fstart (point) | |
1035 | fend (point))) | |
1036 | ;; not end of line so perhaps uncite it | |
1037 | ((looking-at cite-regexp) | |
1038 | (save-excursion | |
1039 | (save-restriction | |
1040 | (narrow-to-region (sc-linepos 'bol) (sc-linepos)) | |
1041 | (beginning-of-line) | |
1042 | (delete-region (point-min) | |
1043 | (progn (re-search-forward cite-regexp | |
1044 | (point-max) | |
1045 | t) | |
1046 | (match-end 0))))))) | |
1047 | (setq fend (point)) | |
1048 | (forward-line 1))))) | |
1049 | ||
1050 | \f | |
1051 | ;; ====================================================================== | |
1052 | ;; this section contains paragraph filling support | |
1053 | ||
1054 | (defun sc-guess-fill-prefix (&optional literalp) | |
1055 | "Guess the fill prefix used on the current line. | |
1056 | Use various heuristics to find the fill prefix. Search begins on first | |
1057 | non-blank line after point. | |
1058 | ||
1059 | 1) If fill-prefix is already bound to the empty string, return | |
1060 | nil. | |
1061 | ||
1062 | 2) If fill-prefix is already bound, but not to the empty | |
1063 | string, return the value of fill-prefix. | |
1064 | ||
1065 | 3) If the current line starts with the last chosen citation | |
1066 | string, then that string is returned. | |
1067 | ||
1068 | 4) If the current line starts with a string matching the regular | |
1069 | expression sc-cite-regexp, return the match. Note that if | |
1070 | optional LITERALP is provided and non-nil, then the *string* | |
1071 | that matches the regexp is return. Otherwise, if LITERALP is | |
1072 | not provided or is nil, the *regexp* sc-cite-regexp is | |
1073 | returned. | |
1074 | ||
1075 | 5) If the current line starts with any number of characters, | |
1076 | followed by the sc-citation-delimiter and then white space, | |
1077 | that match is returned. See comment #4 above for handling of | |
1078 | LITERALP. | |
1079 | ||
1080 | 6) Nil is returned." | |
1081 | (save-excursion | |
1082 | ;; scan for first non-blank line in the region | |
1083 | (beginning-of-line) | |
1084 | (skip-chars-forward "\n\t ") | |
1085 | (beginning-of-line) | |
1086 | (let ((citation (aget sc-gal-information "sc-citation")) | |
1087 | (generic-citation | |
1088 | (concat "\\s *[^ \t\n" sc-citation-delimiter "]+>\\s +"))) | |
1089 | (cond | |
1090 | ((string= fill-prefix "") nil) ;; heuristic #1 | |
1091 | (fill-prefix) ;; heuristic #2 | |
1092 | ((looking-at (regexp-quote citation)) citation) ;; heuristic #3 | |
1093 | ((looking-at sc-cite-regexp) ;; heuristic #4 | |
1094 | (if literalp | |
1095 | (buffer-substring | |
1096 | (point) | |
1097 | (progn (re-search-forward (concat sc-cite-regexp "\\s *") | |
1098 | (point-max) nil) | |
1099 | (point))) | |
1100 | sc-cite-regexp)) | |
1101 | ((looking-at generic-citation) ;; heuristic #5 | |
1102 | (if literalp | |
1103 | (buffer-substring | |
1104 | (point) | |
1105 | (progn (re-search-forward generic-citation) (point))) | |
1106 | generic-citation)) | |
1107 | (t nil))))) ;; heuristic #6 | |
1108 | ||
1109 | (defun sc-consistant-cite-p (prefix) | |
1110 | "Check current paragraph for consistant citation. | |
1111 | Scans to paragraph delineated by (forward|backward)-paragraph to see | |
1112 | if all lines start with PREFIX. Returns t if entire paragraph is | |
1113 | consistantly cited, nil otherwise." | |
1114 | (save-excursion | |
1115 | (let ((end (progn (forward-paragraph) | |
1116 | (beginning-of-line) | |
1117 | (or (not (eolp)) | |
1118 | (forward-char -1)) | |
1119 | (point))) | |
1120 | (start (progn (backward-paragraph) | |
1121 | (beginning-of-line) | |
1122 | (or (not (eolp)) | |
1123 | (forward-char 1)) | |
1124 | (point))) | |
1125 | (badline t)) | |
1126 | (goto-char start) | |
1127 | (beginning-of-line) | |
1128 | (while (and (< (point) end) | |
1129 | badline) | |
1130 | (setq badline (looking-at prefix)) | |
1131 | (forward-line 1)) | |
1132 | badline))) | |
1133 | ||
1134 | (defun sc-fill-start (fill-prefix) | |
1135 | "Find buffer position of start of region which begins with FILL-PREFIX. | |
1136 | Restrict scan to current paragraph." | |
1137 | (save-excursion | |
1138 | (let ((badline nil) | |
1139 | (top (save-excursion | |
1140 | (backward-paragraph) | |
1141 | (beginning-of-line) | |
1142 | (or (not (eolp)) | |
1143 | (forward-char 1)) | |
1144 | (point)))) | |
1145 | (while (and (not badline) | |
1146 | (> (point) top)) | |
1147 | (forward-line -1) | |
1148 | (setq badline (not (looking-at fill-prefix))))) | |
1149 | (forward-line 1) | |
1150 | (point))) | |
1151 | ||
1152 | (defun sc-fill-end (fill-prefix) | |
1153 | "Find the buffer position of end of region which begins with FILL-PREFIX. | |
1154 | Restrict scan to current paragraph." | |
1155 | (save-excursion | |
1156 | (let ((badline nil) | |
1157 | (bot (save-excursion | |
1158 | (forward-paragraph) | |
1159 | (beginning-of-line) | |
1160 | (or (not (eolp)) | |
1161 | (forward-char -1)) | |
1162 | (point)))) | |
1163 | (while (and (not badline) | |
1164 | (< (point) bot)) | |
1165 | (beginning-of-line) | |
1166 | (setq badline (not (looking-at fill-prefix))) | |
1167 | (forward-line 1))) | |
1168 | (forward-line -1) | |
1169 | (point))) | |
1170 | ||
1171 | (defun sc-fill-paragraph () | |
1172 | "Supercite's paragraph fill function. | |
1173 | Fill the paragraph containing or following point. Use | |
1174 | sc-guess-fill-prefix to find the fill-prefix for the paragraph. | |
1175 | ||
1176 | If the paragraph is inconsistantly cited (mixed fill-prefix), then the | |
1177 | user is queried to restrict the the fill to only those lines around | |
1178 | point which begin with the fill prefix. | |
1179 | ||
1180 | The variable sc-fill-arg is passed to fill-paragraph and | |
1181 | fill-region-as-paragraph which controls justification of the | |
1182 | paragraph. sc-fill-arg is set by sc-fill-paragraph-manually." | |
1183 | (save-excursion | |
1184 | (let ((pnt (point)) | |
1185 | (fill-prefix (sc-guess-fill-prefix t))) | |
1186 | (cond | |
1187 | ((not fill-prefix) | |
1188 | (fill-paragraph sc-fill-arg)) | |
1189 | ((sc-consistant-cite-p fill-prefix) | |
1190 | (fill-paragraph sc-fill-arg)) | |
1191 | ((y-or-n-p "Inconsistent citation found. Restrict? ") | |
1192 | (message "") | |
1193 | (fill-region-as-paragraph (progn (goto-char pnt) | |
1194 | (sc-fill-start fill-prefix)) | |
1195 | (progn (goto-char pnt) | |
1196 | (sc-fill-end fill-prefix)) | |
1197 | sc-fill-arg)) | |
1198 | (t | |
1199 | (message "") | |
1200 | (progn | |
1201 | (setq fill-prefix (aget sc-gal-information "sc-citation")) | |
1202 | (fill-paragraph sc-fill-arg))))))) | |
1203 | ||
1204 | \f | |
1205 | ;; ====================================================================== | |
1206 | ;; the following functions are the top level, interactive commands that | |
1207 | ;; can be bound to key strokes | |
1208 | ||
1209 | (defun sc-insert-reference (arg) | |
1210 | "Insert, at point, a reference header in the body of the reply. | |
1211 | Numeric ARG indicates which header style from sc-rewrite-header-list | |
1212 | to use when rewriting the header. No supplied ARG indicates use of | |
1213 | sc-preferred-header-style. | |
1214 | ||
1215 | With just \\[universal-argument], electric reference insert mode is | |
1216 | entered, regardless of the value of sc-electric-references-p. See | |
1217 | sc-electric-mode for more information." | |
1218 | (interactive "P") | |
1219 | (if (consp arg) | |
1220 | (sc-electric-mode) | |
1221 | (let ((pref (cond ((sc-valid-index-p arg) arg) | |
1222 | ((sc-valid-index-p sc-preferred-header-style) | |
1223 | sc-preferred-header-style) | |
1224 | (t 0)))) | |
1225 | (if sc-electric-references-p (sc-electric-mode pref) | |
1226 | (condition-case err | |
1227 | (eval (nth pref sc-rewrite-header-list)) | |
1228 | (void-function | |
1229 | (progn (message | |
1230 | "Symbol's function definition is void: %s. (Header %d)." | |
1231 | (symbol-name (car (cdr err))) | |
1232 | pref) | |
1233 | (beep))) | |
1234 | (error | |
1235 | (progn (message "Error evaluating rewrite header function %d." | |
1236 | pref) | |
1237 | (beep))) | |
1238 | ))))) | |
1239 | ||
1240 | (defun sc-cite (arg) | |
1241 | "Cite the region of text between point and mark. | |
1242 | Numeric ARG, if supplied, is passed unaltered to sc-insert-reference." | |
1243 | (interactive "P") | |
1244 | (if (not (sc-mark)) | |
1245 | (error "Please designate a region to cite (i.e. set the mark).")) | |
1246 | (catch 'select-abort | |
1247 | (let ((sc-cite-context 'citing) | |
1248 | (sc-force-confirmation-p (interactive-p))) | |
1249 | (sc-select) | |
1250 | (undo-boundary) | |
1251 | (let ((xchange (if (> (sc-mark) (point)) nil | |
1252 | (exchange-point-and-mark) | |
1253 | t))) | |
1254 | (sc-insert-reference arg) | |
1255 | (sc-cite-region (point) (sc-mark)) | |
1256 | ;; leave point on first cited line | |
1257 | (while (and (< (point) (sc-mark)) | |
1258 | (not (looking-at (aget sc-gal-information | |
1259 | (if sc-nested-citation-p | |
1260 | "sc-nested-citation" | |
1261 | "sc-citation"))))) | |
1262 | (forward-line 1)) | |
1263 | (and xchange | |
1264 | (exchange-point-and-mark)) | |
1265 | )))) | |
1266 | ||
1267 | (defun sc-uncite () | |
1268 | "Uncite the region between point and mark." | |
1269 | (interactive) | |
1270 | (if (not (sc-mark)) | |
1271 | (error "Please designate a region to uncite (i.e. set the mark).")) | |
1272 | (undo-boundary) | |
1273 | (let ((xchange (if (> (sc-mark) (point)) nil | |
1274 | (exchange-point-and-mark) | |
1275 | t)) | |
1276 | (fp (or (sc-guess-fill-prefix) | |
1277 | ""))) | |
1278 | (sc-uncite-region (point) (sc-mark) fp) | |
1279 | (and xchange | |
1280 | (exchange-point-and-mark)))) | |
1281 | ||
1282 | (defun sc-recite () | |
1283 | "Recite the region by first unciting then citing the text." | |
1284 | (interactive) | |
1285 | (if (not (sc-mark)) | |
1286 | (error "Please designate a region to recite (i.e. set the mark).")) | |
1287 | (catch 'select-abort | |
1288 | (let ((sc-cite-context 'reciting) | |
1289 | (sc-force-confirmation-p t)) | |
1290 | (sc-select) | |
1291 | (undo-boundary) | |
1292 | (let ((xchange (if (> (sc-mark) (point)) nil | |
1293 | (exchange-point-and-mark) | |
1294 | t)) | |
1295 | (fp (or (sc-guess-fill-prefix) | |
1296 | ""))) | |
1297 | (sc-uncite-region (point) (sc-mark) fp) | |
1298 | (sc-cite-region (point) (sc-mark)) | |
1299 | (and xchange | |
1300 | (exchange-point-and-mark)) | |
1301 | )))) | |
1302 | ||
1303 | (defun sc-insert-citation () | |
1304 | "Insert citation string at beginning of current line." | |
1305 | (interactive) | |
1306 | (save-excursion | |
1307 | (beginning-of-line) | |
1308 | (insert (aget sc-gal-information "sc-citation")))) | |
1309 | ||
1310 | (defun sc-open-line (arg) | |
1311 | "Insert a newline and leave point before it. | |
1312 | Also inserts the guessed prefix at the beginning of the new line. With | |
1313 | numeric ARG, inserts that many new lines." | |
1314 | (interactive "p") | |
1315 | (save-excursion | |
1316 | (let ((start (point)) | |
1317 | (string (or (sc-guess-fill-prefix t) | |
1318 | ""))) | |
1319 | (open-line arg) | |
1320 | (goto-char start) | |
1321 | (forward-line 1) | |
1322 | (while (< 0 arg) | |
1323 | (insert string) | |
1324 | (forward-line 1) | |
1325 | (setq arg (- arg 1)))))) | |
1326 | ||
1327 | (defun sc-fill-paragraph-manually (arg) | |
1328 | "Fill current cited paragraph. | |
1329 | Really just runs the hook sc-fill-paragraph-hook, however it does set | |
1330 | the global variable sc-fill-arg to the value of ARG. This is | |
1331 | currently the only way to pass an argument to a hookified function." | |
1332 | (interactive "P") | |
1333 | (setq sc-fill-arg arg) | |
1334 | (run-hooks 'sc-fill-paragraph-hook)) | |
1335 | ||
1336 | (defun sc-modify-information (arg) | |
1337 | "Interactively modify information in the information alist. | |
1338 | \\[universal-argument] if supplied, deletes the entry from the alist. | |
1339 | You can add an entry by supplying a key instead of completing." | |
1340 | (interactive "P") | |
1341 | (let* ((delete-p (consp arg)) | |
1342 | (action (if delete-p "delete" "modify")) | |
1343 | (defaultkey (aheadsym sc-gal-information)) | |
1344 | (prompt (concat "Select information key to " | |
1345 | action ": (default " | |
1346 | defaultkey ") ")) | |
1347 | (key (completing-read prompt sc-gal-information)) | |
1348 | ) | |
1349 | (if (or (string= key "") | |
1350 | (null key)) | |
1351 | (setq key defaultkey)) | |
1352 | (if delete-p (adelete 'sc-gal-information key) | |
1353 | (let* ((oldval (aget sc-gal-information key t)) | |
1354 | (prompt (concat "Enter new value for key \"" | |
1355 | key "\" (default \"" oldval "\") ")) | |
1356 | (newval (read-input prompt))) | |
1357 | (if (or (string= newval "") | |
1358 | (null newval)) | |
1359 | nil | |
1360 | (aput 'sc-gal-information key newval) | |
1361 | ))))) | |
1362 | ||
1363 | (defun sc-view-field (arg) | |
1364 | "View field values in the information alist. | |
1365 | This is essentially an interactive version of sc-field, and is similar | |
1366 | to sc-modify-information, except that the field values can't be | |
1367 | modified. With \\[universal-argument], if supplied, inserts the value | |
1368 | into the current buffer as well." | |
1369 | (interactive "P") | |
1370 | (let* ((defaultkey (aheadsym sc-gal-information)) | |
1371 | (prompt (concat "View information key: (default " | |
1372 | defaultkey ") ")) | |
1373 | (key (completing-read prompt sc-gal-information))) | |
1374 | (if (or (string= key "") | |
1375 | (null key)) | |
1376 | (setq key defaultkey)) | |
1377 | (let* ((val (aget sc-gal-information key t)) | |
1378 | (pval (if val (concat "\"" val "\"") "nil"))) | |
1379 | (message "value of key %s: %s" key pval) | |
1380 | (if (and key (consp arg)) (insert val))))) | |
1381 | ||
1382 | (defun sc-glom-headers () | |
1383 | "Glom information from mail headers in region between point and mark. | |
1384 | Any old information is lost, unless an error occurs." | |
1385 | (interactive) | |
1386 | (let ((attr (copy-sequence sc-gal-attributions)) | |
1387 | (info (copy-sequence sc-gal-information))) | |
1388 | (setq sc-gal-attributions nil | |
1389 | sc-gal-information nil) | |
1390 | (let ((start (region-beginning)) | |
1391 | (end (region-end)) | |
1392 | (sc-force-confirmation-p t) | |
1393 | (sc-cite-context nil)) | |
1394 | (sc-fetch-fields start end) | |
1395 | (if (null sc-gal-information) | |
1396 | (progn | |
1397 | (message "No mail headers found! Restoring old information.") | |
1398 | (setq sc-gal-attributions attr | |
1399 | sc-gal-information info)) | |
1400 | (sc-mail-yank-clear-headers start end) | |
1401 | (if (not (catch 'select-abort | |
1402 | (condition-case foo | |
1403 | (sc-select) | |
1404 | (quit (beep) (throw 'select-abort nil))) | |
1405 | )) | |
1406 | (setq sc-gal-attributions attr | |
1407 | sc-gal-information info)) | |
1408 | )))) | |
1409 | ||
1410 | (defun sc-version (arg) | |
1411 | "Show supercite version. | |
1412 | Universal argument (\\[universal-argument]) ARG inserts version | |
1413 | information in the current buffer instead of printing the message in | |
1414 | the echo area." | |
1415 | (interactive "P") | |
1416 | (if (consp arg) | |
1417 | (insert "Using Supercite version " sc-version-number) | |
1418 | (message "Using Supercite version %s" sc-version-number))) | |
1419 | ||
1420 | \f | |
1421 | ;; ====================================================================== | |
1422 | ;; leach onto current mode | |
1423 | ||
1424 | (defun sc-append-current-keymap () | |
1425 | "Append some useful key bindings to the current local key map. | |
1426 | This searches sc-local-keymap for the keymap to install based on the | |
1427 | major-mode of the current buffer." | |
1428 | (let ((hook (car (cdr (assq major-mode sc-local-keymaps))))) | |
1429 | (cond | |
1430 | ((not hook) | |
1431 | (run-hooks 'sc-default-keymap)) | |
1432 | ((not (listp hook)) | |
1433 | (setq hook (car (cdr (assq hook sc-local-keymaps)))) | |
1434 | (run-hooks 'hook)) | |
1435 | (t | |
1436 | (run-hooks 'hook)))) | |
1437 | (setq sc-leached-keymap (current-local-map))) | |
1438 | ||
1439 | (defun sc-snag-all-keybindings () | |
1440 | "Snag all keybindings in major-mode's current keymap." | |
1441 | (let* ((curkeymap (current-local-map)) | |
1442 | (symregexp ".*sc-.*\n") | |
1443 | (docstring (substitute-command-keys "\\{curkeymap}")) | |
1444 | (start 0) | |
1445 | (maxend (length docstring)) | |
1446 | (spooge "")) | |
1447 | (while (and (< start maxend) | |
1448 | (string-match symregexp docstring start)) | |
1449 | (setq spooge (concat spooge (substring docstring | |
1450 | (match-beginning 0) | |
1451 | (match-end 0)))) | |
1452 | (setq start (match-end 0))) | |
1453 | spooge)) | |
1454 | ||
1455 | (defun sc-spoogify-docstring () | |
1456 | "Modifies (makes into spooge) the docstring for the current major mode. | |
1457 | This will leach the keybinding descriptions for supercite onto the end | |
1458 | of the current major mode's docstring. If major mode is preloaded, | |
1459 | this function will first make a copy of the list associated with the | |
1460 | mode, then modify this copy." | |
1461 | (let* ((symfunc (symbol-function major-mode)) | |
1462 | (doc-cdr (and (listp symfunc) (nthcdr 2 symfunc))) | |
1463 | (doc-str (documentation major-mode))) | |
1464 | (cond | |
1465 | ;; is a docstring even provided? | |
1466 | ((not (stringp doc-str))) | |
1467 | ;; have we already leached on? | |
1468 | ((string-match "Supercite" doc-str)) | |
1469 | ;; lets build the new doc string | |
1470 | (t | |
1471 | (let* ((described (sc-snag-all-keybindings)) | |
1472 | (commonstr " | |
1473 | ||
1474 | The major mode for this buffer has been modified to include the | |
1475 | Supercite 2.3 package for handling attributions and citations of | |
1476 | original messages in email replies. For more information on this | |
1477 | package, type \"\\[sc-describe]\".") | |
1478 | (newdoc-str | |
1479 | (concat doc-str commonstr | |
1480 | (if (not (string= described "")) | |
1481 | (concat "\n\nThe following keys are bound " | |
1482 | "to Supercite commands:\n\n" | |
1483 | described))) | |
1484 | )) | |
1485 | (cond | |
1486 | (doc-cdr | |
1487 | (condition-case nil | |
1488 | (setcar doc-cdr newdoc-str) | |
1489 | (error | |
1490 | ;; the major mode must be preloaded, make a copy first | |
1491 | (setq symfunc (copy-sequence (symbol-function major-mode)) | |
1492 | doc-cdr (nthcdr 2 symfunc)) | |
1493 | (setcar doc-cdr newdoc-str) | |
1494 | (fset major-mode symfunc)))) | |
1495 | ;; lemacs 19 byte-code. | |
1496 | ;; Set function to a new byte-code vector with the | |
1497 | ;; new documentation in the documentation slot (element 4). | |
1498 | ;; We can't use aset because aset won't allow you to modify | |
1499 | ;; a byte-code vector. | |
1500 | ;; Include element 5 if the vector has one. | |
1501 | (t | |
1502 | (fset major-mode | |
1503 | (apply 'make-byte-code | |
1504 | (aref symfunc 0) (aref symfunc 1) | |
1505 | (aref symfunc 2) (aref symfunc 3) | |
1506 | newdoc-str | |
1507 | (if (> (length symfunc) 5) | |
1508 | (list (aref symfunc 5))))) | |
1509 | ))))))) | |
1510 | ||
1511 | \f | |
1512 | ;; ====================================================================== | |
1513 | ;; this section contains default hooks and hook support for execution | |
1514 | ||
1515 | (defun sc-cite-original () | |
1516 | "Hook version of sc-cite. | |
1517 | This is callable from the various mail and news readers' reply | |
1518 | function according to the agreed upon standard. See \\[sc-describe] | |
1519 | for more details. Sc-cite-original does not do any yanking of the | |
1520 | original message but it does require a few things: | |
1521 | ||
1522 | 1) The reply buffer is the current buffer. | |
1523 | ||
1524 | 2) The original message has been yanked and inserted into the | |
1525 | reply buffer. | |
1526 | ||
1527 | 3) Verbose mail headers from the original message have been | |
1528 | inserted into the reply buffer directly before the text of the | |
1529 | original message. | |
1530 | ||
1531 | 4) Point is at the beginning of the verbose headers. | |
1532 | ||
1533 | 5) Mark is at the end of the body of text to be cited." | |
1534 | (run-hooks 'sc-pre-hook) | |
1535 | (setq sc-gal-attributions nil) | |
1536 | (setq sc-gal-information nil) | |
1537 | (let ((start (region-beginning)) | |
1538 | (end (region-end))) | |
1539 | (sc-fetch-fields start end) | |
1540 | (sc-mail-yank-clear-headers start end) | |
1541 | (if (not sc-all-but-cite-p) | |
1542 | (sc-cite sc-preferred-header-style)) | |
1543 | (sc-append-current-keymap) | |
1544 | (sc-spoogify-docstring) | |
1545 | (run-hooks 'sc-post-hook))) | |
1546 | ||
1547 | \f | |
1548 | ;; ====================================================================== | |
1549 | ;; describe this package | |
1550 | ;; | |
1551 | (defun sc-describe () | |
1552 | "Supercite version 2.3 is now described in a texinfo manual which | |
1553 | makes the documenation available both for online perusal via emacs' | |
1554 | info system, or for hard-copy printing using the TeX facility. | |
1555 | ||
1556 | To view the online document hit \\[info], then \"mSupercite <RET>\"." | |
1557 | (interactive) | |
1558 | (describe-function 'sc-describe)) | |
1559 | ||
1560 | ;; ====================================================================== | |
1561 | ;; load hook | |
1562 | (run-hooks 'sc-load-hook) | |
1563 | (provide 'sc) |