787
|
1 ;;; superyank.el --- smart message-yanking code for GNUS
|
|
2
|
841
|
3 ;; Copyright (C) 1992 Free Software Foundation, Inc.
|
|
4
|
787
|
5 ;; Author: Barry A. Warsaw <warsaw@cme.nist.gov>
|
|
6 ;; Version: 1.1
|
|
7 ;; Adapted-By: ESR
|
814
|
8 ;; Keywords: news
|
787
|
9
|
841
|
10 ;; This file is part of GNU Emacs.
|
|
11
|
|
12 ;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
13 ;; it under the terms of the GNU General Public License as published by
|
|
14 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
15 ;; any later version.
|
|
16
|
|
17 ;; GNU Emacs is distributed in the hope that it will be useful,
|
|
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
20 ;; GNU General Public License for more details.
|
|
21
|
|
22 ;; You should have received a copy of the GNU General Public License
|
|
23 ;; along with GNU Emacs; see the file COPYING. If not, write to
|
|
24 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
25
|
787
|
26 ;;; Commentary:
|
658
|
27
|
28
|
28 ;; Inserts the message being replied to with various user controlled
|
|
29 ;; citation styles.
|
|
30 ;;
|
|
31
|
|
32 ;; This file is distributed in the hope that it will be useful,
|
|
33 ;; but WITHOUT ANY WARRANTY. No author or distributor
|
|
34 ;; accepts responsibility to anyone for the consequences of using it
|
|
35 ;; or for whether it serves any particular purpose or works at all,
|
|
36 ;; unless he says so in writing. Refer to the GNU Emacs General Public
|
|
37 ;; License for full details.
|
|
38
|
|
39 ;; Everyone is granted permission to copy, modify and redistribute
|
|
40 ;; this file, but only under the conditions described in the
|
|
41 ;; GNU Emacs General Public License. A copy of this license is
|
|
42 ;; supposed to have been given to you along with GNU Emacs so you
|
|
43 ;; can know your rights and responsibilities. It should be in a
|
|
44 ;; file named COPYING. Among other things, the copyright notice
|
|
45 ;; and this notice must be preserved on all copies.
|
|
46
|
|
47 ;; NAME: Barry A. Warsaw USMAIL: National Institute of Standards
|
|
48 ;; TELE: (301) 975-3460 and Technology (formerly NBS)
|
|
49 ;; UUCP: {...}!uunet!cme-durer!warsaw Rm. B-124, Bldg. 220
|
|
50 ;; ARPA: warsaw@cme.nist.gov Gaithersburg, MD 20899
|
|
51
|
|
52 ;; Modification history:
|
|
53 ;;
|
|
54 ;; modified: 14-Jun-1989 baw (better keymap set procedure, rewrite-headers)
|
|
55 ;; modified: 12-Jun-1989 baw (added defvar for sy-use-only-preference-p)
|
|
56 ;; modified: 6-Jun-1989 baw (better sy-rewrite-headers, no kill/yank)
|
|
57 ;; modified: 5-Jun-1989 baw (requires rnewspost.el)
|
|
58 ;; modified: 1-Jun-1989 baw (persistent attribution, sy-open-line)
|
|
59 ;; modified: 31-May-1989 baw (fixed some gnus problems, id'd another)
|
|
60 ;; modified: 22-May-1989 baw (documentation)
|
|
61 ;; modified: 8-May-1989 baw (auto filling of regions)
|
|
62 ;; modified: 1-May-1989 baw (documentation)
|
|
63 ;; modified: 27-Apr-1989 baw (new preference scheme)
|
|
64 ;; modified: 24-Apr-1989 baw (remove gnus headers, attrib scheme, cite lines)
|
|
65 ;; modified: 19-Apr-1989 baw (cite key, fill p, yank region, naming scheme)
|
|
66 ;; modified: 12-Apr-1989 baw (incorp other mail yank features seen on net)
|
|
67 ;; created : 16-Feb-1989 baw (mod vanilla fn indent-rigidly mail-yank-original)
|
|
68
|
792
|
69 ;; Though I wrote this package basically from scratch, as an Emacs Lisp
|
28
|
70 ;; learning exercise, it was inspired by postings of similar packages to
|
|
71 ;; the gnu.emacs newsgroup over the past month or so.
|
|
72 ;;
|
|
73 ;; Here's a brief history of how this package developed:
|
|
74 ;;
|
|
75 ;; I as well as others on the net were pretty unhappy about the way emacs
|
|
76 ;; cited replies with the tab or 4 spaces. It looked ugly and made it hard
|
|
77 ;; to distinguish between original and cited lines. I hacked on the function
|
|
78 ;; yank-original to at least give the user the ability to define the citation
|
|
79 ;; character. I posted this simple hack, and others did as well. The main
|
|
80 ;; difference between mine and others was that a space was put after the
|
|
81 ;; citation string on on new citations, but not after previously cited lines:
|
|
82 ;;
|
|
83 ;; >> John wrote this originally
|
|
84 ;; > Jane replied to that
|
|
85 ;;
|
|
86 ;; Then Martin Neitzel posted some code that he developed, derived in part
|
|
87 ;; from code that Ashwin Ram posted previous to that. In Martin's
|
|
88 ;; posting, he introduced a new, and (IMHO) superior, citation style,
|
|
89 ;; eliminating nested citations. Yes, I wanted to join the Small-But-
|
|
90 ;; Growing-Help-Stamp-Out-Nested-Citation-Movement! You should too.
|
|
91 ;;
|
|
92 ;; But Martin's code simply asks the user for the citation string (here
|
|
93 ;; after called the `attribution' string), and I got to thinking, it wouldn't
|
|
94 ;; be that difficult to automate that part. So I started hacking this out.
|
|
95 ;; It proved to be not as simple as I first thought. But anyway here it
|
|
96 ;; is. See the wish list below for future plans (if I have time).
|
|
97 ;;
|
|
98 ;; Type "C-h f mail-yank-original" after this package is loaded to get a
|
|
99 ;; description of what it does and the variables that control it.
|
|
100 ;;
|
|
101 ;; ======================================================================
|
|
102 ;;
|
|
103 ;; Changes wish list
|
|
104 ;;
|
|
105 ;; 1) C-x C-s yanks a region from the RMAIL buffer instead of the
|
|
106 ;; whole buffer
|
|
107 ;;
|
|
108 ;; 2) reparse nested citations to try to recast as non-nested citations
|
|
109 ;; perhaps by checking the References: line
|
|
110 ;;
|
787
|
111
|
|
112 ;;; Code:
|
|
113
|
28
|
114 ;; ======================================================================
|
|
115 ;;
|
|
116 ;; require and provide features
|
|
117 ;;
|
|
118 (require 'sendmail)
|
|
119 ;;
|
|
120 ;; ======================================================================
|
|
121 ;;
|
|
122 ;; don't need rnewspost.el to rewrite the header. This only works
|
|
123 ;; with diffs to rnewspost.el that I posted with the original
|
|
124 ;; superyank code.
|
|
125 ;;
|
|
126 (setq news-reply-header-hook nil)
|
|
127
|
|
128 ;; **********************************************************************
|
|
129 ;; start of user defined variables
|
|
130 ;; **********************************************************************
|
|
131 ;;
|
|
132 ;; this section defines variables that control the operation of
|
|
133 ;; super-mail-yank. Most of these are described in the comment section
|
|
134 ;; as well as the DOCSTRING.
|
|
135 ;;
|
|
136
|
|
137 ;;
|
|
138 ;; ----------------------------------------------------------------------
|
|
139 ;;
|
|
140 ;; this variable holds the default author's name for citations
|
|
141 ;;
|
|
142 (defvar sy-default-attribution "Anon"
|
|
143 "String that describes attribution to unknown person. This string
|
|
144 should not contain the citation string.")
|
|
145
|
|
146 ;;
|
|
147 ;; ----------------------------------------------------------------------
|
|
148 ;;
|
|
149 ;; string used as an end delimiter for both nested and non-nested citations
|
|
150 ;;
|
|
151 (defvar sy-citation-string ">"
|
|
152 "String to use as an end-delimiter for citations. This string is
|
|
153 used in both nested and non-nested citations. For best results, use a
|
|
154 single character with no trailing space. Most commonly used string
|
|
155 is: \">\.")
|
|
156
|
|
157 ;;
|
|
158 ;; ----------------------------------------------------------------------
|
|
159 ;;
|
|
160 ;; variable controlling citation type, nested or non-nested
|
|
161 ;;
|
|
162 (defvar sy-nested-citation-p nil
|
|
163 "Non-nil uses nested citations, nil uses non-nested citations.
|
|
164 Nested citations are of the style:
|
|
165
|
|
166 I wrote this
|
|
167 > He wrote this
|
|
168 >> She replied to something he wrote
|
|
169
|
|
170 Non-nested citations are of the style:
|
|
171
|
|
172 I wrote this
|
|
173 John> He wrote this
|
|
174 Jane> She originally wrote this")
|
|
175
|
|
176
|
|
177 ;;
|
|
178 ;; ----------------------------------------------------------------------
|
|
179 ;;
|
|
180 ;; regular expression that matches existing citations
|
|
181 ;;
|
|
182 (defvar sy-cite-regexp "[a-zA-Z0-9]*>"
|
|
183 "Regular expression that describes how an already cited line in an
|
|
184 article begins. The regexp is only used at the beginning of a line,
|
|
185 so it doesn't need to begin with a '^'.")
|
|
186
|
|
187 ;;
|
|
188 ;; ----------------------------------------------------------------------
|
|
189 ;;
|
|
190 ;; regular expression that delimits names from titles in the field that
|
|
191 ;; looks like: (John X. Doe -- Computer Hacker Extraordinaire)
|
|
192 ;;
|
|
193 (defvar sy-titlecue-regexp "\\s +-+\\s +"
|
|
194
|
|
195 "Regular expression that delineates names from titles in the name
|
|
196 field. Often, people will set up their name field to look like this:
|
|
197
|
|
198 (John Xavier Doe -- Computer Hacker Extraordinaire)
|
|
199
|
|
200 Set to nil to treat entire field as a name.")
|
|
201
|
|
202 ;;
|
|
203 ;; ----------------------------------------------------------------------
|
|
204 ;;
|
|
205 ;;
|
|
206 (defvar sy-preferred-attribution 2
|
|
207
|
|
208 "This is an integer indicating what the user's preference is in
|
|
209 attribution style, based on the following key:
|
|
210
|
|
211 0: email address name is preferred
|
|
212 1: initials are preferred
|
|
213 2: first name is preferred
|
|
214 3: last name is preferred
|
|
215
|
|
216 The value of this variable may also be greater than 3, which would
|
|
217 allow you to prefer the 2nd through nth - 1 name. If the preferred
|
|
218 attribution is nil or the empty string, then the secondary preferrence
|
|
219 will be the first name. After that, the entire name alist is search
|
|
220 until a non-empty, non-nil name is found. If no such name is found,
|
|
221 then the user is either queried or the default attribution string is
|
|
222 used depending on the value of sy-confirm-always-p.
|
|
223
|
|
224 Examples:
|
|
225
|
|
226 assume the from: line looks like this:
|
|
227
|
|
228 from: doe@computer.some.where.com (John Xavier Doe)
|
|
229
|
|
230 The following preferences would return these strings:
|
|
231
|
|
232 0: \"doe\"
|
|
233 1: \"JXD\"
|
|
234 2: \"John\"
|
|
235 3: \"Doe\"
|
|
236 4: \"Xavier\"
|
|
237
|
|
238 anything else would return \"John\".")
|
|
239
|
|
240 ;;
|
|
241 ;; ----------------------------------------------------------------------
|
|
242 ;;
|
|
243 (defvar sy-confirm-always-p t
|
|
244 "If t, always confirm attribution string before inserting into
|
|
245 buffer.")
|
|
246
|
|
247
|
|
248 ;;
|
|
249 ;; ----------------------------------------------------------------------
|
|
250 ;;
|
|
251 ;; informative header hook
|
|
252 ;;
|
|
253 (defvar sy-rewrite-header-hook 'sy-header-on-said
|
|
254 "Hook for inserting informative header at the top of the yanked
|
|
255 message. Set to nil for no header. Here is a list of predefined
|
|
256 header styles; you can use these as a model to write you own:
|
|
257
|
|
258 sy-header-on-said [default]: On 14-Jun-1989 GMT,
|
|
259 John Xavier Doe said:
|
|
260
|
|
261 sy-header-inarticle-writes: In article <123456789> John Xavier Doe writes:
|
|
262
|
|
263 sy-header-regarding-writes: Regarding RE: superyank; John Xavier Doe adds:
|
|
264
|
|
265 sy-header-verbose: On 14-Jun-1989 GMT, John Xavier Doe
|
|
266 from the organization Great Company
|
|
267 has this to say about article <123456789>
|
|
268 in newsgroups misc.misc
|
|
269 concerning RE: superyank
|
|
270 referring to previous articles <987654321>
|
|
271
|
|
272 You can use the following variables as information strings in your header:
|
|
273
|
|
274 sy-reply-yank-date: the date field [ex: 14-Jun-1989 GMT]
|
|
275 sy-reply-yank-from: the from field [ex: John Xavier Doe]
|
|
276 sy-reply-yank-message-id: the message id [ex: <123456789>]
|
|
277 sy-reply-yank-subject: the subject line [ex: RE: superyank]
|
|
278 sy-reply-yank-newsgroup: the newsgroup name for GNUS [ex: misc.misc]
|
|
279 sy-reply-yank-references: the article references [ex: <987654321>]
|
|
280 sy-reply-yank-organization: the author's organization [ex: Great Company]
|
|
281
|
|
282 If a field can't be found, because it doesn't exist or is not being
|
|
283 shown, perhaps because of toggle-headers, the corresponding field
|
|
284 variable will contain the string \"mumble mumble\".")
|
|
285
|
|
286 ;;
|
|
287 ;; ----------------------------------------------------------------------
|
|
288 ;;
|
|
289 ;; non-nil means downcase the author's name string
|
|
290 ;;
|
|
291 (defvar sy-downcase-p nil
|
|
292 "Non-nil means downcase the author's name string.")
|
|
293
|
|
294 ;;
|
|
295 ;; ----------------------------------------------------------------------
|
|
296 ;;
|
|
297 ;; controls removal of leading white spaces
|
|
298 ;;
|
|
299 (defvar sy-left-justify-p nil
|
|
300 "If non-nil, delete all leading white space before citing.")
|
|
301
|
|
302 ;;
|
|
303 ;; ----------------------------------------------------------------------
|
|
304 ;;
|
|
305 ;; controls auto filling of region
|
|
306 ;;
|
|
307 (defvar sy-auto-fill-region-p nil
|
|
308 "If non-nil, automatically fill each paragraph that is cited. If
|
|
309 nil, do not auto fill each paragraph.")
|
|
310
|
|
311
|
|
312 ;;
|
|
313 ;; ----------------------------------------------------------------------
|
|
314 ;;
|
|
315 ;; controls use of preferred attribution only, or use of attribution search
|
|
316 ;; scheme if the preferred attrib can't be found.
|
|
317 ;;
|
|
318 (defvar sy-use-only-preference-p nil
|
|
319
|
|
320 "If non-nil, then only the preferred attribution string will be
|
|
321 used. If the preferred attribution string can not be found, then the
|
|
322 sy-default-attribution will be used. If nil, and the preferred
|
|
323 attribution string is not found, then some secondary scheme will be
|
|
324 employed to find a suitable attribution string.")
|
|
325
|
|
326 ;; **********************************************************************
|
|
327 ;; end of user defined variables
|
|
328 ;; **********************************************************************
|
|
329
|
|
330 ;;
|
|
331 ;; ----------------------------------------------------------------------
|
|
332 ;;
|
|
333 ;; The new citation style means we can clean out other headers in addition
|
|
334 ;; to those previously cleaned out. Anyway, we create our own headers.
|
|
335 ;; Also, we want to clean out any headers that gnus puts in. Add to this
|
|
336 ;; for other mail or news readers you may be using.
|
|
337 ;;
|
|
338 (setq mail-yank-ignored-headers "^via:\\|^origin:\\|^status:\\|^re\\(mail\\|ceiv\\)ed\\|^[a-z-]*message-id:\\|^\\(summary-\\)?line[s]?:\\|^cc:\\|^subject:\\|^\\(\\(in-\\)?reply-\\)?to:\\|^\\(\\(return\\|reply\\)-\\)?path:\\|^\\(posted-\\)?date:\\|^\\(mail-\\)?from:\\|^newsgroup[s]?:\\|^organization:\\|^keywords:\\|^distribution:\\|^references:")
|
|
339
|
|
340 ;;
|
|
341 ;; ----------------------------------------------------------------------
|
|
342 ;;
|
|
343 ;; global variables, not user accessable
|
|
344 ;;
|
|
345 (setq sy-persist-attribution (concat sy-default-attribution "> "))
|
|
346 (setq sy-reply-yank-date "")
|
|
347 (setq sy-reply-yank-from "")
|
|
348 (setq sy-reply-yank-message-id "")
|
|
349 (setq sy-reply-yank-subject "")
|
|
350 (setq sy-reply-yank-newsgroups "")
|
|
351 (setq sy-reply-yank-references "")
|
|
352 (setq sy-reply-yank-organization "")
|
|
353
|
|
354 ;;
|
|
355 ;; ======================================================================
|
|
356 ;;
|
|
357 ;; This section contains primitive functions used in the schemes. They
|
|
358 ;; extract name fields from various parts of the "from:" field based on
|
|
359 ;; the control variables described above.
|
|
360 ;;
|
|
361 ;; Some will use recursion to pick out the correct namefield in the namestring
|
|
362 ;; or the list of initials. These functions all scan a string that contains
|
|
363 ;; the name, ie: "John Xavier Doe". There is no limit on the number of names
|
|
364 ;; in the string. Also note that all white spaces are basically ignored and
|
|
365 ;; are stripped from the returned strings, and titles are ignored if
|
|
366 ;; sy-titlecue-regexp is set to non-nil.
|
|
367 ;;
|
|
368 ;; Others will use methods to try to extract the name from the email
|
|
369 ;; address of the originator. The types of addresses readable are
|
|
370 ;; described above.
|
|
371
|
|
372 ;;
|
|
373 ;; ----------------------------------------------------------------------
|
|
374 ;;
|
|
375 ;; try to extract the name from an email address of the form
|
|
376 ;; name%[stuff]
|
|
377 ;;
|
|
378 ;; Unlike the get-name functions above, these functions operate on the
|
|
379 ;; buffer instead of a supplied name-string.
|
|
380 ;;
|
|
381 (defun sy-%-style-address ()
|
|
382 (beginning-of-line)
|
|
383 (buffer-substring
|
|
384 (progn (re-search-forward "%" (point-max) t)
|
|
385 (if (not (bolp)) (forward-char -1))
|
|
386 (point))
|
|
387 (progn (re-search-backward "^\\|[^a-zA-Z0-9]")
|
|
388 (point))))
|
|
389
|
|
390 ;;
|
|
391 ;; ----------------------------------------------------------------------
|
|
392 ;;
|
|
393 ;; try to extract names from addresses with the form:
|
|
394 ;; [stuff]name@[stuff]
|
|
395 ;;
|
|
396 (defun sy-@-style-address ()
|
|
397 (beginning-of-line)
|
|
398 (buffer-substring
|
|
399 (progn (re-search-forward "@" (point-max) t)
|
|
400 (if (not (bolp)) (forward-char -1))
|
|
401 (point))
|
|
402 (progn (re-search-backward "^\\|[^a-zA-Z0-0]")
|
|
403 (if (not (bolp)) (forward-char 1))
|
|
404 (point))))
|
|
405
|
|
406 ;;
|
|
407 ;; ----------------------------------------------------------------------
|
|
408 ;;
|
|
409 ;; try to extract the name from addresses with the form:
|
|
410 ;; [stuff]![stuff]...!name[stuff]
|
|
411 ;;
|
|
412 (defun sy-!-style-address ()
|
|
413 (beginning-of-line)
|
|
414 (buffer-substring
|
|
415 (progn (while (re-search-forward "!" (point-max) t))
|
|
416 (point))
|
|
417 (progn (re-search-forward "[^a-zA-Z0-9]\\|$")
|
|
418 (if (not (eolp)) (forward-char -1))
|
|
419 (point))))
|
|
420
|
|
421 ;;
|
|
422 ;; ----------------------------------------------------------------------
|
|
423 ;;
|
|
424 ;; using the different email name schemes, try each one until you get a
|
|
425 ;; non-nil entry
|
|
426 ;;
|
|
427 (defun sy-get-emailname ()
|
|
428 (let ((en1 (sy-%-style-address))
|
|
429 (en2 (sy-@-style-address))
|
|
430 (en3 (sy-!-style-address)))
|
|
431 (cond
|
|
432 ((not (string-equal en1 "")) en1)
|
|
433 ((not (string-equal en2 "")) en2)
|
|
434 ((not (string-equal en3 "")) en3)
|
|
435 (t ""))))
|
|
436
|
|
437 ;;
|
|
438 ;; ----------------------------------------------------------------------
|
|
439 ;;
|
|
440 ;; returns the "car" of the namestring, really the first namefield
|
|
441 ;;
|
|
442 ;; (sy-string-car "John Xavier Doe")
|
|
443 ;; => "John"
|
|
444 ;;
|
|
445 (defun sy-string-car (namestring)
|
|
446 (substring namestring
|
|
447 (progn (string-match "\\s *" namestring) (match-end 0))
|
|
448 (progn (string-match "\\s *\\S +" namestring) (match-end 0))))
|
|
449
|
|
450 ;;
|
|
451 ;; ----------------------------------------------------------------------
|
|
452 ;;
|
|
453 ;; returns the "cdr" of the namestring, really the whole string from
|
|
454 ;; after the first name field to the end of the string.
|
|
455 ;;
|
|
456 ;; (sy-string-cdr "John Xavier Doe")
|
|
457 ;; => "Xavier Doe"
|
|
458 ;;
|
|
459 (defun sy-string-cdr (namestring)
|
|
460 (substring namestring
|
|
461 (progn (string-match "\\s *\\S +\\s *" namestring)
|
|
462 (match-end 0))))
|
|
463
|
|
464 ;;
|
|
465 ;; ----------------------------------------------------------------------
|
|
466 ;;
|
|
467 ;; convert a namestring to a list of namefields
|
|
468 ;;
|
|
469 ;; (sy-namestring-to-list "John Xavier Doe")
|
|
470 ;; => ("John" "Xavier" "Doe")
|
|
471 ;;
|
|
472 (defun sy-namestring-to-list (namestring)
|
|
473 (if (not (string-match namestring ""))
|
|
474 (append (list (sy-string-car namestring))
|
|
475 (sy-namestring-to-list (sy-string-cdr namestring)))))
|
|
476
|
|
477 ;;
|
|
478 ;; ----------------------------------------------------------------------
|
|
479 ;;
|
|
480 ;; strip the initials from each item in the list and return a string
|
|
481 ;; that is the concatenation of the initials
|
|
482 ;;
|
|
483 (defun sy-strip-initials (raw-nlist)
|
|
484 (if (not raw-nlist)
|
|
485 nil
|
|
486 (concat (substring (car raw-nlist) 0 1)
|
|
487 (sy-strip-initials (cdr raw-nlist)))))
|
|
488
|
|
489
|
|
490 ;;
|
|
491 ;; ----------------------------------------------------------------------
|
|
492 ;;
|
|
493 ;; using the namestring, build a list which is in the following order
|
|
494 ;;
|
|
495 ;; (email, initials, firstname, lastname, name1, name2, name3 ... nameN-1)
|
|
496 ;;
|
|
497 (defun sy-build-ordered-namelist (namestring)
|
|
498 (let* ((raw-nlist (sy-namestring-to-list namestring))
|
|
499 (initials (sy-strip-initials raw-nlist))
|
|
500 (firstname (car raw-nlist))
|
|
501 (revnames (reverse (cdr raw-nlist)))
|
|
502 (lastname (car revnames))
|
|
503 (midnames (reverse (cdr revnames)))
|
|
504 (emailnames (sy-get-emailname)))
|
|
505 (append (list emailnames)
|
|
506 (list initials)
|
|
507 (list firstname)
|
|
508 (list lastname)
|
|
509 midnames)))
|
|
510
|
|
511 ;;
|
|
512 ;; ----------------------------------------------------------------------
|
|
513 ;;
|
|
514 ;; Query the user for the attribution string. Supply sy-default-attribution
|
|
515 ;; as the default choice.
|
|
516 ;;
|
|
517 (defun sy-query-for-attribution ()
|
|
518 (concat
|
|
519 (let* ((prompt (concat "Enter attribution string: (default "
|
|
520 sy-default-attribution
|
|
521 ") "))
|
|
522 (query (read-input prompt))
|
|
523 (attribution (if (string-equal query "")
|
|
524 sy-default-attribution
|
|
525 query)))
|
|
526 (if sy-downcase-p
|
|
527 (downcase attribution)
|
|
528 attribution))
|
|
529 sy-citation-string))
|
|
530
|
|
531
|
|
532 ;;
|
|
533 ;; ----------------------------------------------------------------------
|
|
534 ;;
|
|
535 ;; parse the current line for the namestring
|
|
536 ;;
|
|
537 (defun sy-get-namestring ()
|
|
538 (save-restriction
|
|
539 (beginning-of-line)
|
|
540 (if (re-search-forward "(.*)" (point-max) t)
|
|
541 (let ((start (progn
|
|
542 (beginning-of-line)
|
|
543 (re-search-forward "\\((\\s *\\)\\|$" (point-max) t)
|
|
544 (point)))
|
|
545 (end (progn
|
|
546 (re-search-forward
|
|
547 (concat "\\(\\s *\\()\\|" sy-titlecue-regexp "\\)\\)\\|$")
|
|
548 (point-max) t)
|
|
549 (point))))
|
|
550 (narrow-to-region start end)
|
|
551 (let ((start (progn
|
|
552 (beginning-of-line)
|
|
553 (point)))
|
|
554 (end (progn
|
|
555 (end-of-line)
|
|
556 (re-search-backward
|
|
557 (concat "\\s *\\()\\|" sy-titlecue-regexp "\\)$")
|
|
558 (point-min) t)
|
|
559 (point))))
|
|
560 (buffer-substring start end)))
|
|
561 (let ((start (progn
|
|
562 (beginning-of-line)
|
|
563 (re-search-forward "^\"*")
|
|
564 (point)))
|
|
565 (end (progn
|
|
566 (re-search-forward "\\(\\s *[a-zA-Z0-9\\.]+\\)*"
|
|
567 (point-max) t)
|
|
568 (point))))
|
|
569 (buffer-substring start end)))))
|
|
570
|
|
571
|
|
572 ;;
|
|
573 ;; ----------------------------------------------------------------------
|
|
574 ;;
|
|
575 ;; scan the nlist and return the integer pointing to the first legal
|
|
576 ;; non-empty namestring. Returns the integer pointing to the index
|
|
577 ;; in the nlist of the preferred namestring, or nil if no legal
|
|
578 ;; non-empty namestring could be found.
|
|
579 ;;
|
|
580 (defun sy-return-preference-n (nlist)
|
|
581 (let ((p sy-preferred-attribution)
|
|
582 (exception nil))
|
|
583 ;;
|
|
584 ;; check to be sure the index is not out-of-bounds
|
|
585 ;;
|
|
586 (cond
|
|
587 ((< p 0) (setq p 2) (setq exception t))
|
|
588 ((not (nth p nlist)) (setq p 2) (setq exception t)))
|
|
589 ;;
|
|
590 ;; check to be sure that the explicit preference is not empty
|
|
591 ;;
|
|
592 (if (string-equal (nth p nlist) "")
|
|
593 (progn (setq p 0)
|
|
594 (setq exception t)))
|
|
595 ;;
|
|
596 ;; find the first non-empty namestring
|
|
597 ;;
|
|
598 (while (and (nth p nlist)
|
|
599 (string-equal (nth p nlist) ""))
|
|
600 (setq exception t)
|
|
601 (setq p (+ p 1)))
|
|
602 ;;
|
|
603 ;; return the preference index if non-nil, otherwise nil
|
|
604 ;;
|
|
605 (if (or (and exception sy-use-only-preference-p)
|
|
606 (not (nth p nlist)))
|
|
607 nil
|
|
608 p)))
|
|
609
|
|
610 ;;
|
|
611 ;;
|
|
612 ;; ----------------------------------------------------------------------
|
|
613 ;;
|
|
614 ;; rebuild the nlist into an alist for completing-read. Use as a guide
|
|
615 ;; the index of the preferred name field. Get the actual preferred
|
|
616 ;; name field base on other factors (see above). If no actual preferred
|
|
617 ;; name field is found, then query the user for the attribution string.
|
|
618 ;;
|
|
619 ;; also note that the nlist is guaranteed to be non-empty. At the very
|
|
620 ;; least it will consist of 4 empty strings ("" "" "" "")
|
|
621 ;;
|
|
622 (defun sy-nlist-to-alist (nlist)
|
|
623 (let ((preference (sy-return-preference-n nlist))
|
|
624 alist
|
|
625 (n 0))
|
|
626 ;;
|
|
627 ;; check to be sure preference is not nil
|
|
628 ;;
|
|
629 (if (not preference)
|
|
630 (setq alist (list (cons (sy-query-for-attribution) nil)))
|
|
631 ;;
|
|
632 ;; preference is non-nil
|
|
633 ;;
|
|
634 (setq alist (list (cons (nth preference nlist) nil)))
|
|
635 (while (nth n nlist)
|
|
636 (if (= n preference) nil
|
|
637 (setq alist (append alist (list (cons (nth n nlist) nil)))))
|
|
638 (setq n (+ n 1))))
|
|
639 alist))
|
|
640
|
|
641
|
|
642
|
|
643 ;;
|
|
644 ;; ----------------------------------------------------------------------
|
|
645 ;;
|
|
646 ;; confirm if desired after the alist has been built
|
|
647 ;;
|
|
648 (defun sy-get-attribution (alist)
|
|
649 (concat
|
|
650 ;;
|
|
651 ;; check to see if nested citations are to be used
|
|
652 ;;
|
|
653 (if sy-nested-citation-p
|
|
654 ""
|
|
655 ;;
|
|
656 ;; check to see if confirmation is needed
|
|
657 ;; if not, just return the preference (first element in alist)
|
|
658 ;;
|
|
659 (if (not sy-confirm-always-p)
|
|
660 (car (car alist))
|
|
661 ;;
|
|
662 ;; confirmation is requested so build the prompt, confirm
|
|
663 ;; and return the chosen string
|
|
664 ;;
|
|
665 (let* (ignore
|
|
666 (prompt (concat "Complete attribution string: (default "
|
|
667 (car (car alist))
|
|
668 ") "))
|
|
669 ;;
|
|
670 ;; set up the local completion keymap
|
|
671 ;;
|
|
672 (minibuffer-local-must-match-map
|
|
673 (let ((map (make-sparse-keymap)))
|
|
674 (define-key map "?" 'minibuffer-completion-help)
|
|
675 (define-key map " " 'minibuffer-complete-word)
|
|
676 (define-key map "\t" 'minibuffer-complete)
|
|
677 (define-key map "\00A" 'exit-minibuffer)
|
|
678 (define-key map "\00D" 'exit-minibuffer)
|
|
679 (define-key map "\007"
|
|
680 '(lambda ()
|
|
681 (interactive)
|
|
682 (beep)
|
|
683 (exit-minibuffer)))
|
|
684 map))
|
|
685 ;;
|
|
686 ;; read the completion
|
|
687 ;;
|
|
688 (attribution (completing-read prompt alist))
|
|
689 ;;
|
|
690 ;; check attribution string for emptyness
|
|
691 ;;
|
|
692 (choice (if (or (not attribution)
|
|
693 (string-equal attribution ""))
|
|
694 (car (car alist))
|
|
695 attribution)))
|
|
696
|
|
697 (if sy-downcase-p
|
|
698 (downcase choice)
|
|
699 choice))))
|
|
700 sy-citation-string))
|
|
701
|
|
702
|
|
703 ;;
|
|
704 ;; ----------------------------------------------------------------------
|
|
705 ;;
|
|
706 ;; this function will scan the current rmail buffer, narrowing it to the
|
|
707 ;; from: line, then using this, it will try to decipher some names from
|
|
708 ;; that line. It will then build the name alist and try to confirm
|
|
709 ;; its choice of attribution strings. It returns the chosen attribution
|
|
710 ;; string.
|
|
711 ;;
|
|
712 (defun sy-scan-rmail-for-names (rmailbuffer)
|
|
713 (save-excursion
|
|
714 (let ((case-fold-search t)
|
|
715 alist
|
|
716 attribution)
|
|
717 (switch-to-buffer rmailbuffer)
|
|
718 (goto-char (point-min))
|
|
719 ;;
|
|
720 ;; be sure there is a from: line
|
|
721 ;;
|
|
722 (if (not (re-search-forward "^from:\\s *" (point-max) t))
|
|
723 (setq attribution (sy-query-for-attribution))
|
|
724 ;;
|
|
725 ;; if there is a from: line, then scan the narrow the buffer,
|
|
726 ;; grab the namestring, and build the alist, then using this
|
|
727 ;; get the attribution string.
|
|
728 ;;
|
|
729 (save-restriction
|
|
730 (narrow-to-region (point)
|
|
731 (progn (end-of-line) (point)))
|
|
732 (let* ((namestring (sy-get-namestring))
|
|
733 (nlist (sy-build-ordered-namelist namestring)))
|
|
734 (setq alist (sy-nlist-to-alist nlist))))
|
|
735 ;;
|
|
736 ;; we've built the alist, now confirm the attribution choice
|
|
737 ;; if appropriate
|
|
738 ;;
|
|
739 (setq attribution (sy-get-attribution alist)))
|
|
740 attribution)))
|
|
741
|
|
742
|
|
743 ;;
|
|
744 ;; ======================================================================
|
|
745 ;;
|
|
746 ;; the following function insert of citations, writing of headers, filling
|
|
747 ;; paragraphs and general higher level operations
|
|
748 ;;
|
|
749
|
|
750 ;;
|
|
751 ;; ----------------------------------------------------------------------
|
|
752 ;;
|
|
753 ;; insert a nested citation
|
|
754 ;;
|
|
755 (defun sy-insert-citation (start end cite-string)
|
|
756 (save-excursion
|
|
757 (goto-char end)
|
|
758 (setq end (point-marker))
|
|
759 (goto-char start)
|
|
760 (or (bolp)
|
|
761 (forward-line 1))
|
|
762
|
|
763 (let ((fill-prefix (concat cite-string " "))
|
|
764 (fstart (point))
|
|
765 (fend (point)))
|
|
766
|
|
767 (while (< (point) end)
|
|
768 ;;
|
|
769 ;; remove leading tabs if desired
|
|
770 ;;
|
|
771 (if sy-left-justify-p
|
|
772 (delete-region (point)
|
|
773 (progn (skip-chars-forward " \t") (point))))
|
|
774 ;;
|
|
775 ;; check to see if the current line should be cited
|
|
776 ;;
|
|
777 (if (or (eolp)
|
|
778 (looking-at sy-cite-regexp))
|
|
779 ;;
|
|
780 ;; do not cite this line unless nested-citations are to be
|
|
781 ;; used
|
|
782 ;;
|
|
783 (progn
|
|
784 (or (eolp)
|
|
785 (if sy-nested-citation-p
|
|
786 (insert cite-string)))
|
|
787
|
|
788 ;; set fill start and end points
|
|
789 ;;
|
|
790 (or (= fstart fend)
|
|
791 (not sy-auto-fill-region-p)
|
|
792 (progn (goto-char fend)
|
|
793 (or (not (eolp))
|
|
794 (setq fend (+ fend 1)))
|
|
795 (fill-region-as-paragraph fstart fend)))
|
|
796 (setq fstart (point))
|
|
797 (setq fend (point)))
|
|
798
|
|
799 ;; else
|
|
800 ;;
|
|
801 (insert fill-prefix)
|
|
802 (end-of-line)
|
|
803 (setq fend (point)))
|
|
804
|
|
805 (forward-line 1)))
|
|
806 (move-marker end nil)))
|
|
807
|
|
808 ;;
|
|
809 ;; ----------------------------------------------------------------------
|
|
810 ;;
|
|
811 ;; yank a particular field into a holding variable
|
|
812 ;;
|
|
813 (defun sy-yank-fields (start)
|
|
814 (save-excursion
|
|
815 (goto-char start)
|
|
816 (setq sy-reply-yank-date (mail-fetch-field "date")
|
|
817 sy-reply-yank-from (mail-fetch-field "from")
|
|
818 sy-reply-yank-subject (mail-fetch-field "subject")
|
|
819 sy-reply-yank-newsgroups (mail-fetch-field "newsgroups")
|
|
820 sy-reply-yank-references (mail-fetch-field "references")
|
|
821 sy-reply-yank-message-id (mail-fetch-field "message-id")
|
|
822 sy-reply-yank-organization (mail-fetch-field "organization"))
|
|
823 (or sy-reply-yank-date
|
|
824 (setq sy-reply-yank-date "mumble mumble"))
|
|
825 (or sy-reply-yank-from
|
|
826 (setq sy-reply-yank-from "mumble mumble"))
|
|
827 (or sy-reply-yank-subject
|
|
828 (setq sy-reply-yank-subject "mumble mumble"))
|
|
829 (or sy-reply-yank-newsgroups
|
|
830 (setq sy-reply-yank-newsgroups "mumble mumble"))
|
|
831 (or sy-reply-yank-references
|
|
832 (setq sy-reply-yank-references "mumble mumble"))
|
|
833 (or sy-reply-yank-message-id
|
|
834 (setq sy-reply-yank-message-id "mumble mumble"))
|
|
835 (or sy-reply-yank-organization
|
|
836 (setq sy-reply-yank-organization "mumble mumble"))))
|
|
837
|
|
838 ;;
|
|
839 ;; ----------------------------------------------------------------------
|
|
840 ;;
|
|
841 ;; rewrite the header to be more conversational
|
|
842 ;;
|
|
843 (defun sy-rewrite-headers (start)
|
|
844 (goto-char start)
|
|
845 (run-hooks 'sy-rewrite-header-hook))
|
|
846
|
|
847 ;;
|
|
848 ;; ----------------------------------------------------------------------
|
|
849 ;;
|
|
850 ;; some different styles of headers
|
|
851 ;;
|
|
852 (defun sy-header-on-said ()
|
|
853 (insert-string "\nOn " sy-reply-yank-date ",\n"
|
|
854 sy-reply-yank-from " said:\n"))
|
|
855
|
|
856 (defun sy-header-inarticle-writes ()
|
|
857 (insert-string "\nIn article " sy-reply-yank-message-id
|
|
858 " " sy-reply-yank-from " writes:\n"))
|
|
859
|
|
860 (defun sy-header-regarding-writes ()
|
|
861 (insert-string "\nRegarding " sy-reply-yank-subject
|
|
862 "; " sy-reply-yank-from " adds:\n"))
|
|
863
|
|
864 (defun sy-header-verbose ()
|
|
865 (insert-string "\nOn " sy-reply-yank-date ",\n"
|
|
866 sy-reply-yank-from "\nfrom the organization "
|
|
867 sy-reply-yank-organization "\nhad this to say about article "
|
|
868 sy-reply-yank-message-id "\nin newsgroups "
|
|
869 sy-reply-yank-newsgroups "\nconcerning "
|
|
870 sy-reply-yank-subject "\nreferring to previous articles "
|
|
871 sy-reply-yank-references "\n"))
|
|
872
|
|
873 ;;
|
|
874 ;; ----------------------------------------------------------------------
|
|
875 ;;
|
|
876 ;; yank the original article in and attribute
|
|
877 ;;
|
|
878 (defun sy-yank-original (arg)
|
|
879
|
|
880 "Insert the message being replied to, if any (in rmail/gnus). Puts
|
|
881 point before the text and mark after. Calls generalized citation
|
|
882 function sy-insert-citation to cite all allowable lines."
|
|
883
|
|
884 (interactive "P")
|
|
885 (if mail-reply-buffer
|
|
886 (let* ((sy-confirm-always-p (if (consp arg)
|
|
887 t
|
|
888 sy-confirm-always-p))
|
|
889 (attribution (sy-scan-rmail-for-names mail-reply-buffer))
|
|
890 (top (point))
|
|
891 (start (point))
|
|
892 (end (progn (delete-windows-on mail-reply-buffer)
|
|
893 (insert-buffer mail-reply-buffer)
|
|
894 (mark))))
|
|
895
|
|
896 (sy-yank-fields start)
|
|
897 (sy-rewrite-headers start)
|
|
898 (setq start (point))
|
|
899 (mail-yank-clear-headers top (mark))
|
|
900 (setq sy-persist-attribution (concat attribution " "))
|
|
901 (sy-insert-citation start end attribution))
|
|
902
|
|
903 (goto-char top)
|
|
904 (exchange-point-and-mark)))
|
|
905
|
|
906
|
|
907 ;;
|
|
908 ;; ----------------------------------------------------------------------
|
|
909 ;;
|
|
910 ;; this is here for compatibility with existing mail/news yankers
|
|
911 ;; overloads the default mail-yank-original
|
|
912 ;;
|
|
913 (defun mail-yank-original (arg)
|
|
914
|
|
915 "Yank original message buffer into the reply buffer, citing as per
|
|
916 user preferences. Numeric Argument forces confirmation.
|
|
917
|
|
918 Here is a description of the superyank.el package, what it does and
|
|
919 what variables control its operation. This was written by Barry
|
|
920 Warsaw (warsaw@cme.nist.gov, {...}!uunet!cme-durer!warsaw).
|
|
921
|
|
922 A 'Citation' is the acknowledgement of the original author of a mail
|
|
923 message. There are two general forms of citation. In 'nested
|
|
924 citations', indication is made that the cited line was written by
|
|
925 someone *other* that the current message author (or by that author at
|
|
926 an earlier time). No indication is made as to the identity of the
|
|
927 original author. Thus, a nested citation after multiple replies would
|
|
928 look like this (this is after my reply to a previous message):
|
|
929
|
|
930 >>John originally wrote this
|
|
931 >>and this as well
|
|
932 > Jane said that John didn't know
|
|
933 > what he was talking about
|
|
934 And that's what I think as well.
|
|
935
|
|
936 In non-nested citations, you won't see multiple \">\" characters at
|
|
937 the beginning of the line. Non-nested citations will insert an
|
|
938 informative string at the beginning of a cited line, attributing that
|
|
939 line to an author. The same message described above might look like
|
|
940 this if non-nested citations were used:
|
|
941
|
|
942 John> John originally wrote this
|
|
943 John> and this as well
|
|
944 Jane> Jane said that John didn't know
|
|
945 Jane> what he was talking about
|
|
946 And that's what I think as well.
|
|
947
|
|
948 Notice that my inclusion of Jane's inclusion of John's original
|
|
949 message did not result in a cited line of the form: Jane>John>. Thus
|
|
950 no nested citations. The style of citation is controlled by the
|
|
951 variable `sy-nested-citation-p'. Nil uses non-nested citations and
|
|
952 non-nil uses old style, nested citations.
|
|
953
|
|
954 The variable `sy-citation-string' is the string to use as a marker for
|
|
955 a citation, either nested or non-nested. For best results, this
|
|
956 string should be a single character with no trailing space and is
|
|
957 typically the character \">\". In non-nested citations this string is
|
|
958 appended to the attribution string (author's name), along with a
|
|
959 trailing space. In nested citations, a trailing space is only added
|
|
960 to a first level citation.
|
|
961
|
|
962 Another important variable is `sy-cite-regexp' which describes strings
|
|
963 that indicate a previously cited line. This regular expression is
|
|
964 always used at the beginning of a line so it doesn't need to begin
|
|
965 with a \"^\" character. Change this variable if you change
|
|
966 `sy-citation-string'.
|
|
967
|
|
968 The following section only applies to non-nested citations.
|
|
969
|
|
970 This package has a fair amount of intellegence related to deciphering
|
|
971 the author's name based on information provided by the original
|
|
972 message buffer. In normal operation, the program will pick out the
|
|
973 author's first and last names, initials, terminal email address and
|
|
974 any other names it can find. It will then pick an attribution string
|
|
975 from this list based on a user defined preference and it will ask for
|
|
976 confirmation if the user specifies. This package gathers its
|
|
977 information from the `From:' line of the original message buffer. It
|
|
978 recognizes From: lines with the following forms:
|
|
979
|
|
980 From: John Xavier Doe <doe@speedy.computer.com>
|
|
981 From: \"John Xavier Doe\" <doe@speedy.computer.com>
|
|
982 From: doe@speedy.computer.com (John Xavier Doe)
|
|
983 From: computer!speedy!doe (John Xavier Doe)
|
|
984 From: computer!speedy!doe (John Xavier Doe)
|
|
985 From: doe%speedy@computer.com (John Xavier Doe)
|
|
986
|
|
987 In this case, if confirmation is requested, the following strings will
|
|
988 be made available for completion and confirmation:
|
|
989
|
|
990 \"John\"
|
|
991 \"Xavier\"
|
|
992 \"Doe\"
|
|
993 \"JXD\"
|
|
994 \"doe\"
|
|
995
|
|
996 Note that completion is case sensitive. If there was a problem
|
|
997 picking out a From: line, or any other problem getting even a single
|
|
998 name, then the user will be queried for an attribution string. The
|
|
999 default attribution string is set in the variable
|
|
1000 `sy-default-attribution'.
|
|
1001
|
|
1002 Sometimes people set their name fields so that it also includes a
|
|
1003 title of the form:
|
|
1004
|
|
1005 From: doe@speedy.computer.com (John Doe -- Hacker Extraordinaire)
|
|
1006
|
|
1007 To avoid the inclusion of the string \"-- Hacker Extraordinaire\" in
|
|
1008 the name list, the variable `sy-titlecue-regexp' is provided. Its
|
|
1009 default setting will still properly recognize names of the form:
|
|
1010
|
|
1011 From: xdoe@speedy.computer.com (John Xavier-Doe -- Crazed Hacker)
|
|
1012
|
|
1013 The variable `sy-preferred-attribution' contains an integer that
|
|
1014 indicates which name field the user prefers to use as the attribution
|
|
1015 string, based on the following key:
|
|
1016
|
|
1017 0: email address name is preferred
|
|
1018 1: initials are preferred
|
|
1019 2: first name is preferred
|
|
1020 3: last name is preferred
|
|
1021
|
|
1022 The value can be greater than 3, in which case, you would be
|
|
1023 preferring the 2nd throught nth -1 name. In any case, if the
|
|
1024 preferred name can't be found, then one of two actions will be taken
|
|
1025 depending on the value of the variable `sy-use-only-preference-p'. If
|
|
1026 this is non-nil, then the `sy-default-attribution will be used. If it
|
|
1027 is nil, then a secondary scheme will be employed to find a suitable
|
|
1028 attribution scheme. First, the author's first name will be used. If
|
|
1029 that can't be found than the name list is searched for the first
|
|
1030 non-nil, non-empty name string. If still no name can be found, then
|
|
1031 the user is either queried, or the `sy-default-attribution' is used,
|
|
1032 depending on the value of `sy-confirm-always-p'.
|
|
1033
|
|
1034 If the variable `sy-confirm-always-p' is non-nil, superyank will always
|
|
1035 confirm the attribution string with the user before inserting it into
|
|
1036 the reply buffer. Confirmation is with completion, but the completion
|
|
1037 list is merely a suggestion; the user can override the list by typing
|
|
1038 in a string of their choice.
|
|
1039
|
|
1040 The variable `sy-rewrite-header-hook' is a hook that contains a lambda
|
|
1041 expression which rewrites the informative header at the top of the
|
|
1042 yanked message. Set to nil to avoid writing any header.
|
|
1043
|
|
1044 You can make superyank autofill each paragraph it cites by setting the
|
|
1045 variable `sy-auto-fill-region-p' to non-nil. Or set the variable to nil
|
|
1046 and fill the paragraphs manually with sy-fill-paragraph-manually (see
|
|
1047 below).
|
|
1048
|
|
1049 Finally, `sy-downcase-p' if non-nil, indicates that you always want to
|
|
1050 downcase the attribution string before insertion, and
|
|
1051 `sy-left-justify-p', if non-nil, indicates that you want to delete all
|
|
1052 leading white space before citing.
|
|
1053
|
|
1054 Since the almost all yanking in other modes (RMAIL, GNUS) is done
|
|
1055 through the function `mail-yank-original', and since superyank
|
|
1056 overloads this function, cited yanking is automatically bound to the
|
|
1057 C-c C-y key. There are three other smaller functions that are
|
|
1058 provided with superyank and they are bound as below. Try C-h f on
|
|
1059 each function to get more information on these functions.
|
|
1060
|
|
1061 Key Bindings:
|
|
1062
|
|
1063 C-c C-y mail-yank-original (superyank's version)
|
|
1064 C-c q sy-fill-paragraph-manually
|
|
1065 C-c C-q sy-fill-paragraph-manually
|
|
1066 C-c i sy-insert-persist-attribution
|
|
1067 C-c C-i sy-insert-persist-attribution
|
|
1068 C-c C-o sy-open-line
|
|
1069
|
|
1070
|
|
1071 Summary of variables, with their default values:
|
|
1072
|
|
1073 sy-default-attribution (default: \"Anon\")
|
|
1074 Attribution to use if no attribution string can be deciphered
|
|
1075 from the original message buffer.
|
|
1076
|
|
1077 sy-citation-string (default: \">\")
|
|
1078 String to append to the attribution string for citation, for
|
|
1079 best results, it should be one character with no trailing space.
|
|
1080
|
|
1081 sy-nested-citation-p (default: nil)
|
|
1082 Nil means use non-nested citations, non-nil means use old style
|
|
1083 nested citations.
|
|
1084
|
|
1085 sy-cite-regexp (default: \"[a-zA-Z0-9]*>\")
|
|
1086 Regular expression that matches the beginning of a previously
|
|
1087 cited line. Always used at the beginning of a line so it does
|
|
1088 not need to start with a \"^\" character.
|
|
1089
|
|
1090 sy-titlecue-regexp (default: \"\\s +-+\\s +\")
|
|
1091 Regular expression that matches a title delimiter in the name
|
|
1092 field.
|
|
1093
|
|
1094 sy-preferred-attribution (default: 2)
|
|
1095 Integer indicating user's preferred attribution field.
|
|
1096
|
|
1097 sy-confirm-always-p (default: t)
|
|
1098 Non-nil says always confirm with completion before inserting
|
|
1099 attribution.
|
|
1100
|
|
1101 sy-rewrite-header-hook (default: 'sy-header-on-said)
|
|
1102 Hook for inserting informative header at the top of the yanked
|
|
1103 message.
|
|
1104
|
|
1105 sy-downcase-p (default: nil)
|
|
1106 Non-nil says downcase the attribution string before insertion.
|
|
1107
|
|
1108 sy-left-justify-p (default: nil)
|
|
1109 Non-nil says delete leading white space before citing.
|
|
1110
|
|
1111 sy-auto-fill-region-p (default: nil)
|
|
1112 Non-nil says don't auto fill the region. T says auto fill the
|
|
1113 paragraph.
|
|
1114
|
|
1115 sy-use-only-preference-p (default: nil)
|
|
1116 If nil, use backup scheme when preferred attribution string
|
|
1117 can't be found. If non-nil and preferred attribution string
|
|
1118 can't be found, then use sy-default-attribution."
|
|
1119
|
|
1120 (interactive "P")
|
|
1121
|
|
1122 (local-set-key "\C-cq" 'sy-fill-paragraph-manually)
|
|
1123 (local-set-key "\C-c\C-q" 'sy-fill-paragraph-manually)
|
|
1124 (local-set-key "\C-c\i" 'sy-insert-persist-attribution)
|
|
1125 (local-set-key "\C-c\C-i" 'sy-insert-persist-attribution)
|
|
1126 (local-set-key "\C-c\C-o" 'sy-open-line)
|
|
1127
|
|
1128 (sy-yank-original arg))
|
|
1129
|
|
1130
|
|
1131 ;;
|
|
1132 ;; ----------------------------------------------------------------------
|
|
1133 ;;
|
|
1134 ;; based on Bruce Israel's "fill-paragraph-properly", and modified from
|
|
1135 ;; code posted by David C. Lawrence. Modified to use the persistant
|
|
1136 ;; attribution if none could be found from the paragraph.
|
|
1137 ;;
|
|
1138 (defun sy-fill-paragraph-manually (arg)
|
1543
|
1139 "Fill paragraph containing or following point.
|
|
1140 This automatically finds the sy-cite-regexp and uses it as the prefix.
|
|
1141 If the sy-cite-regexp is not in the first line of the paragraph, it
|
|
1142 makes a guess at what the fill-prefix for the paragraph should be by
|
|
1143 looking at the first line and taking anything up to the first
|
|
1144 alphanumeric character.
|
28
|
1145
|
|
1146 Prefix arg means justify both sides of paragraph as well.
|
|
1147
|
|
1148 This function just does fill-paragraph if the fill-prefix is set. If
|
|
1149 what it deduces to be the paragraph prefix (based on the first line)
|
|
1150 does not precede each line in the region, then the persistant
|
|
1151 attribution is used. The persistant attribution is just the last
|
|
1152 attribution string used to cite lines."
|
|
1153
|
|
1154 (interactive "P")
|
|
1155 (save-excursion
|
|
1156 (forward-paragraph)
|
|
1157 (or (bolp)
|
|
1158 (newline 1))
|
|
1159
|
|
1160 (let ((end (point))
|
|
1161 st
|
|
1162 (fill-prefix fill-prefix))
|
|
1163 (backward-paragraph)
|
|
1164 (if (looking-at "\n")
|
|
1165 (forward-char 1))
|
|
1166 (setq st (point))
|
|
1167 (if fill-prefix
|
|
1168 nil
|
|
1169 (untabify st end) ;; die, scurvy tabs!
|
|
1170 ;;
|
|
1171 ;; untabify might have made the paragraph longer character-wise,
|
|
1172 ;; make sure end reflects the correct location of eop.
|
|
1173 ;;
|
|
1174 (forward-paragraph)
|
|
1175 (setq end (point))
|
|
1176 (goto-char st)
|
|
1177 (if (looking-at sy-cite-regexp)
|
|
1178 (setq fill-prefix (concat
|
|
1179 (buffer-substring
|
|
1180 st (progn (re-search-forward sy-cite-regexp)
|
|
1181 (point)))
|
|
1182 " "))
|
|
1183 ;;
|
|
1184 ;; this regexp is is convenient because paragraphs quoted by simple
|
|
1185 ;; indentation must still yield to us <evil laugh>
|
|
1186 ;;
|
|
1187 (while (looking-at "[^a-zA-Z0-9]")
|
|
1188 (forward-char 1))
|
|
1189 (setq fill-prefix (buffer-substring st (point))))
|
|
1190 (next-line 1) (beginning-of-line)
|
|
1191 (while (and (< (point) end)
|
|
1192 (not (string-equal fill-prefix "")))
|
|
1193 ;;
|
|
1194 ;; if what we decided was the fill-prefix does not precede all
|
|
1195 ;; of the lines in the paragraph, we probably goofed. In this
|
|
1196 ;; case set it to the persistant attribution.
|
|
1197 ;;
|
|
1198 (if (looking-at (regexp-quote fill-prefix))
|
|
1199 ()
|
|
1200 (setq fill-prefix sy-persist-attribution))
|
|
1201 (next-line 1)
|
|
1202 (beginning-of-line)))
|
|
1203 (fill-region-as-paragraph st end arg))))
|
|
1204
|
|
1205 ;;
|
|
1206 ;; ----------------------------------------------------------------------
|
|
1207 ;;
|
|
1208 ;; insert the persistant attribution at point
|
|
1209 ;;
|
|
1210 (defun sy-insert-persist-attribution ()
|
1543
|
1211 "Insert the persistant attribution.
|
|
1212 This inserts the peristant attribution at the beginning of the line that
|
28
|
1213 point is on. This string is the last attribution confirmed and used
|
|
1214 in the yanked reply buffer."
|
|
1215 (interactive)
|
|
1216 (save-excursion
|
|
1217 (beginning-of-line)
|
|
1218 (insert-string sy-persist-attribution)))
|
|
1219
|
|
1220
|
|
1221 ;;
|
|
1222 ;; ----------------------------------------------------------------------
|
|
1223 ;;
|
|
1224 ;; open a line putting the attribution at the beginning
|
|
1225
|
|
1226 (defun sy-open-line (arg)
|
1543
|
1227 "Insert a newline and leave point before it.
|
|
1228 Also inserts the persistant attribution at the beginning of the line.
|
|
1229 With argument, inserts ARG newlines."
|
28
|
1230 (interactive "p")
|
|
1231 (save-excursion
|
|
1232 (let ((start (point)))
|
|
1233 (open-line arg)
|
|
1234 (goto-char start)
|
|
1235 (forward-line)
|
|
1236 (while (< 0 arg)
|
|
1237 (sy-insert-persist-attribution)
|
|
1238 (forward-line 1)
|
|
1239 (setq arg (- arg 1))))))
|
|
1240
|
584
|
1241 (provide 'superyank)
|
|
1242
|
658
|
1243 ;;; superyank.el ends here
|