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