Mercurial > emacs
annotate lisp/=superyank.el @ 3377:68cd0dabfce7
(float_to_string): Skip `-' like digits when ensuring
result looks like a float.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Tue, 01 Jun 1993 03:33:40 +0000 |
parents | acdf9d64d086 |
children |
rev | line source |
---|---|
787
3cece0106722
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
658
diff
changeset
|
1 ;;; superyank.el --- smart message-yanking code for GNUS |
3cece0106722
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
658
diff
changeset
|
2 |
841 | 3 ;; Copyright (C) 1992 Free Software Foundation, Inc. |
4 | |
787
3cece0106722
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
658
diff
changeset
|
5 ;; Author: Barry A. Warsaw <warsaw@cme.nist.gov> |
3cece0106722
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
658
diff
changeset
|
6 ;; Version: 1.1 |
3cece0106722
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
658
diff
changeset
|
7 ;; Adapted-By: ESR |
814
38b2499cb3e9
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
792
diff
changeset
|
8 ;; Keywords: news |
787
3cece0106722
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
658
diff
changeset
|
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
3cece0106722
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
658
diff
changeset
|
26 ;;; Commentary: |
658
7cbd4fcd8b0f
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
584
diff
changeset
|
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
45d748a65f24
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
787
diff
changeset
|
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
3cece0106722
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
658
diff
changeset
|
111 |
3cece0106722
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
658
diff
changeset
|
112 ;;; Code: |
3cece0106722
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
658
diff
changeset
|
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
7cbd4fcd8b0f
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
584
diff
changeset
|
1243 ;;; superyank.el ends here |