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