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